#!/usr/sbin/rsct/perl5/bin/perl
# IBM_PROLOG_BEGIN_TAG 
# This is an automatically generated prolog. 
#  
#  
#  
# Licensed Materials - Property of IBM 
#  
# (C) COPYRIGHT International Business Machines Corp. 2000,2004 
# All Rights Reserved 
#  
# US Government Users Restricted Rights - Use, duplication or 
# disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
#  
# IBM_PROLOG_END_TAG 

# "@(#)98   1.44   src/rsct/pts/pam/config/linux_gpfs/cthats.perl, topology.services, rsct_rzauh, rzauh0431a 7/6/04 23:49:52"

#########################################################################
#                                                                       #
# Todo now:                                                             #
#                                                                       #
# Todo:                                                                 #
#                                                                       #
#     Keep the output of ct_hats_info and ct_topology_info in a list    #
#         variable instead of a file.                                   #
#     Sub-net support: need to add SUBNET keyword in HATS/CCAL interface#
#     Multiple heartbeat ring in a subnet                               #
#     Non-IP adapters                                                   #
#     Network type validation: check the device name in ADAPTER line    #
#         matches the network type specified by NETWORK_TYPE            #
#     Network configuration validation: duplicated IP address, sub-net  #
#         range, ....                                                   #
#     Not to exit from leaf level subroutines, return error code instead#
#     IPv6                                                              #
#                                                                       #
# Perl notes:                                                           #
#                                                                       #
#     -X operators: Perl checks file permission bits for its -X file    #
#         operations. This may not be reliable for files in AFS because #
#         AFS uses the ACL instead of the file permission bits.         #
#         e.g. Perl -r operation may return false if the read permission#
#         bit is not on when the file may be actually readable in AFS.  #
#         Fortunately, the filesystems HATS uses, e.g. /var, are usually#
#         in local filesystems. We use Perl -X operators until someone  #
#         actually puts these filesystems on AFS.                       #
#                                                                       #
#########################################################################

#########################################################################
#                                                                       #
# HATS startup script                                                   #
#                                                                       #
# Syntax:                                                               #
#     cthats -h                                                         #
#     cthats -b [-c clusterinfo_file | -C cluster_info_cmd]             #
#         [-i hats_info_file | -I hats_info_cmd]                        #
#         [-t topology_file | -T topology_cmd]                          #
#         [-m machines.lst | -M write_mach_lst_cmd] [-v]                #
#     cthats [-e | -n | -r] [-c clusterinfo_file | -C cluster_info_cmd] #
#         [-m machines.lst | -M read_mach_lst_cmd]                      #
#     cthats -V variable[:value]                                        #
#                                                                       #
# Description: command line option processing.                          #
#     options:                                                          #
#     -b build machines.lst                                             #
#     -c text file name containing cluster info in standard format      #
#     -C command name to produce cluster info in standard format        #
#     -e starts hats subsystem with Dead Man Switch enabled             #
#     -h print usage message                                            #
#     -i hats_info_file: specify the text file that contains the HATS   #
#         global parameters in the standard format                      #
#     -I hats_info_cmd: specify the executable that produces the HATS   #
#         global parameters to standard output                          #
#     -m path of machines.lst.                                          #
#     -l RSCTActiveVersion (level) as w.x.y.z                           #
#     -M command to load/store machines.lst from/to repository.         #
#     -n Do everything except for executing HATS daemon.                #
#     -r refresh hats subsystem                                         #
#     -t topology_file: specify the text file that contains the HATS    #
#         topology information in the standard format                   #
#     -T topology_cmd: specify the executable that produces the HATS    #
#         topology information to standard output                       #
#     -v print the input files in standard error with a leading '#'     #
#     -V variable[:value]                                               #
#        variable:value: specify the variable and value to check.       #
#        variable      : print the default value                        #
#                                                                       #
#     This script performs four different kinds of functions.           #
#     -h : print usage                                                  #
#     -b : build configuration                                          #
#     -e, -n: execute HATS daemon                                       #
#     -r : refresh HATS daemon                                          #
#     -V : check/get valid values for HATS parameters                   #
#                                                                       #
#     Option -c and -C are mutually exclusive. "-C ct_clusterinfo" is   #
#     used if neither one is specified. Option -i and -I are mutually   #
#     exclusive. "-I ct_hats_info" is used if neither one is specified. #
#     Option -t and -T are mutually exclusive. "-T ct_topology_info"    #
#     is used if neither one is specified. The output machines.lst      #
#     file is sent to standard output if the -m option is not used.     #
#                                                                       #
# EXIT code:                                                            #
#     Usually, this script returns 0 on success, non-0 on error.        #
#     However, -V option has different use of exit code. See the        #
#     descriptions in hats_chk_values() for detail.                     #
#                                                                       #
#########################################################################

#########################################################################
#                                                                       #
# Note about the naming convention of HATS scripts and subsystem:       #
#     Suppose the name of HATS start-up script is called ${HATS}, then: #
#     - The control script should be called ${HATS}ctrl                 #
#     - The HATS subsystem name in src is ${HATS}                       #
#     - The HATS daemon name:                                           #
#       + If the start-up script name is the official name "cthats",    #
#         the start-up script will start the official deamon "hatsd".   #
#       + Otherwise, the start-up script will try ${HATS}d if it exists #
#         and is executable. Otherwise, "hatsd" is started.             #
#                                                                       #
# Based on the above naming convention, the following names are used:   #
#     Start-up    Control     Subsysname  daemon                        #
# --------------------------------------------------------------------- #
#     cthats      cthatsctrl  cthats      hatsd                         #
#     hats        hatsctrl    hats        hatsd                         #
#     topsvcs     topsvcsctrl topsvcs     topsvcsd or hatsd             #
#     myhats      myhatsctrl  myhats      myhatsd or hatsd              #
#                                                                       #
#########################################################################
#                                                                       #
# External commands used:                                               #
#                                                                       #
#     cat                                                               #
#     chmod                                                             #
#     cksum                                                             #
#     cp                                                                #
#     echo                                                              #
#     grep                                                              #
#     ls                                                                #
#     mkdir                                                             #
#     mv                                                                #
#     printenv                                                          #
#     refresh                                                           #
#     rm                                                                #
#     tail                                                              #
#     $RSCT_BIN/fcistm                                                  #
#     $RSCT_BIN/fclogerr                                                #
#     $RSCT_BIN/haDMS/haDMS_load ($RSCT_BIN/haDMS/haDMS_kex)            #
#     $RSCT_BIN/haDMS/haDMS_query                                       #
#     $RSCT_BIN/ctmsskf                                                 #
#                                                                       #
# The following external commands can be overridden by the command line #
# options for developing and debugging purposes. The default commands   #
# listed below are used if not overridden by the command line options.  #
# This script expects all the following commands exit with exit code 0  #
# if succeed or non-0 otherwise.                                        #
#                                                                       #
#     Cluster info: (can be overridden by -C option)                    #
#         $RSCT_BIN/ct_clusterinfo                                      #
#     HATS info: (can be overridden by -I option)                       #
#         $RSCT_BIN/ct_hats_info                                        #
#     HATS topology info: (can be overridden by -T option)              #
#         $RSCT_BIN/ct_topology_info                                    #
#     Read machine list: (can be overridden by -M option)               #
#         $RSCT_BIN/ct_read_machines_lst                                #
#     Write machine list: (can be overridden by -M option)              #
#         $RSCT_BIN/ct_write_machines_lst                               #
#                                                                       #
#########################################################################

#=======================================================================#
#                                                                       #
# Main program starts                                                   #
#                                                                       #
#=======================================================================#

die "Requires Perl Version 5, this is Version $]\n" if $] < 5.000;

$|=1; # force a flush after every print
use File::Basename;     # for basename()
use POSIX;              # for uname()
use Getopt::Std;	# for getopts()
$LPP_NAME = "rsct";
$SCCSID_VERSION = "1.3";
$RSCT_ROOT = "/usr/sbin/rsct";
$RSCT_BIN = "$RSCT_ROOT/bin";
$RSCT_INC = "$RSCT_ROOT/include";
$RSCT_MSGMAP = "$RSCT_ROOT/msgmaps";
# fcistm initializes FFDC environment. fcinit.*sh call fcistm to do the job.
$FFDC_FCINIT = "$RSCT_BIN/fcistm";
$FFDC_FCLOGERR = "$RSCT_BIN/fclogerr";
$FFDC_TEMPLATE_INCLUDE_FILE = "$RSCT_INC/hats.err.S.h";
#$ffdc_string_size = 100;        # FFDC detailed data string size
# Mapping from the last two characters of FFDC template IDs to FFDC event types.
%FFDC_EVENT_TYPE = (
    "EM" => "FFDC_EMERG",
    "ER" => "FFDC_ERROR",
    "ST" => "FFDC_STATE",
    "PE" => "FFDC_PERF",
    "TR" => "FFDC_TRACE",
    "RE" => "FFDC_RECOV",
    "DE" => "FFDC_DEBUG"
);

# determine my working environment
($SYS_SYSNAME, $SYS_NODENAME, $SYS_RELEASE, $SYS_VERSION, $SYS_MACHINE) =
    POSIX::uname();
$junk = $SYS_NODENAME; $junk = $SYS_RELEASE;    # Dummy statement to get rid of
$junk = $SYS_VERSION; $junk = $SYS_MACHINE;     # "used only once" warnnings.
$DFLT_CLUSTER_DIR = "/var/ct";
$DFLT_CLUSTER_INFO = "$RSCT_BIN/ct_clusterinfo";
$DFLT_RAV_COMMAND= "$DFLT_CLUSTER_INFO -v";
$DFLT_HATS_INFO = "$RSCT_BIN/ct_hats_info";
$DFLT_TOPOLOGY_INFO = "$RSCT_BIN/ct_topology_info";
$DFLT_MACHINES_LST = "machines.lst";
$DFLT_READ_MACH_LST = "$RSCT_BIN/ct_read_machines_lst";
$DFLT_WRITE_MACH_LST = "$RSCT_BIN/ct_write_machines_lst";
$DFLT_NUMERIC_VALUE = -1;
$DFLT_STRING_VALUE = "DEFAULT";
$DAEMON_SFX = "d";
$OFFICIAL_NAME = "cthats";
$OFFICIAL_DAEMON = "hatsd";
$SPACE_CHARS = " 	\n";            # space, tab, and carrage return
$PAT_ADAPTER_BASE = "[A-Za-z]+[0-9]+";  # Base network adapter name. e.g. eth0
$PAT_ADAPTER_NAS = $PAT_ADAPTER_BASE . "(-[0-9]+)?";    # w/NAS ext e.g. eth0-5
$PAT_ADAPTER_FULL = $PAT_ADAPTER_NAS . "(:[0-9]+)?";    # w/alias e.g. eth0-5:10
$PAT_IP_ADDRESS = "[0-9]{1,3}(\\.[0-9]{1,3}){3}";

# 0: no debug info, 1: brief info, 2: detailed info, 3: very detailed
# Use subroutine name for key and debug level for value. e.g. "main" => 1.
# Please keep this hash in lexical order for human easy search.
%HATS_DBG=(
    "argument_syntax_chk" => 0,
    "clean_old_files" => 0,
    "de_quote" => 0,
    "ffdc_errlog" => 0,
    "get_cluster_info" => 0,
    "get_emsg_body" => 0,
    "get_exit_code" => 0,
    "get_set_env" => 0,
    "hats_chk_values" => 0,
    "hats_mach_lst_gen" => 0,
    "load_machines_lst" => 0,
    "log_core_cleanup" => 0,
    "main" => 0,
    "output_mach_lst" => 0,
    "parse_keyw_val" => 0,
    "parse_adapter_kw" => 0,
    "run_command" => 0,
    "set_net_option" => 0,
    "set_verify_option" => 0,
    "valid_ip_or_dev" => 0,
    "valid_interface" => 0
);

$NUM_SCRIPT_LOGS_TO_KEEP = 7;
$NUM_DAEMON_LOGS_TO_KEEP = 5;
$NUM_CORES_TO_KEEP = 2;
$MAX_OLD_CORE_SIZE = 20480;     # Total old core files shouldn't exceed 20480 K
$MAX_OLD_LOG_SIZE = 10240;
# Set up PATH so that external commands do not need to use absolute paths.
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:/usr/sbin:${RSCT_BIN}";

# Set up variables depending on the subsystem name.
$SUBSYS = basename($0);
$SCRIPT = $SUBSYS;
$DAEMON = $SUBSYS . $DAEMON_SFX;
if (("$SUBSYS" eq "$OFFICIAL_NAME") || (! -x "$RSCT_BIN/$DAEMON")) {
    $DAEMON = $OFFICIAL_DAEMON;
}

# Use daemon name instead of subsystem name to determine message catalogue name. 
# The official name of this script is cthats but the message catalogue is hats.cat.
$CATFILE = $DAEMON;
$CATFILE =~ s/${DAEMON_SFX}$/.cat/;
$MSGSET = "script";
$ENV{MSGMAPPATH} = "$RSCT_MSGMAP";
$MSGCMD = "$RSCT_BIN/ctdspmsg $MSGSET $CATFILE";

$RSCTActiveVersion = "-1";

# End of variable initialization

    if ($HATS_DBG{"main"}) {
        print STDERR "main(): $0 starts. SUBSYS=$SUBSYS\n";
    }

    # AIX lft terminal mode is used for command line mode when AIX boots up.
    # AIX lft terminal doesn't have the ability to display non-ASCII characters.
    # Messages printed at boot time are not displayed correctly in a non-ASCII
    # system locale. AIX 5.1 sets LC_MESSAGES to C@lft at boot time to force
    # messages to be displayed in C locale. The Topology Services start-up
    # script and daemon print their messages to log files. No message is 
    # printed to the screen. Unset LC_MESSAGES to print messages in the
    # correct locale if LC_MESSAGES is C@lft.
    if ("$SYS_SYSNAME" eq "AIX") {
        if (exists($ENV{LC_MESSAGES}) && ($ENV{LC_MESSAGES} eq "C\@lft")) {
            delete($ENV{LC_MESSAGES});
        }
    }

    $PRINT_ENG_MSG = (is_english_locale()) ? 0 : 1;

    # @ARGV may be changed in argument_syntax_chk(). We need to save
    # the contents of @ARGV but do not want to print it until we are
    # ready to write script log.
    # run_command() returns a list. We need to use join() here even
    # if the date command has single line output.
    $cmd_line = join(' ', run_command("", "date"));
    chomp($cmd_line);           # chop trailing "\n".
    $cmd_line .= " $SUBSYS starts:$0 " . join(' ', @ARGV);

    umask(022);
    # List of important files to be saved for debugging.
    @files_to_save_in_log = ();
    @files_to_remove_when_die = ();
    # Initialize FFDC variables and environment variables.
    call_ffdcinit();

    # Syntax error and help message can be handled quickly.
    # We handle them separately.
    if (argument_syntax_chk() != 0) {
        print_usage();
        exit(1);
    }

    # Do script log management for daemon execution related options only.
    $daemon_exec_opt = (exists($opts{e}) && $opts{e} ||
        exists($opts{n}) && $opts{n} || exists($opts{N}) && $opts{N})
        ? 1 : 0;

    if (exists($opts{h}) && $opts{h}) {
        print_usage();
        exit(0);
    }

    # hats_chk_values_init() is required in all operations except -h.
    # Moreover, it checks if the current operating system is supported.
    # Run hats_chk_values_init() as early as possible.
    if (hats_chk_values_init() != 0) {
        ffdc_errlog("ERRID_TS_UNSUPPORT_SYS_ER", __LINE__,
            "ALPHA,ALPHA", "50,50", $SYS_SYSNAME, $SYS_MACHINE);
        #System $SYS_SYSNAME/$SYS_MACHINE is not supported.\n
        fatal_error(1, "EMSG678", "$SCRIPT", "$SYS_SYSNAME", "$SYS_MACHINE");
    }

    # -V option is actually used by other Topology Services components
    # to check/get valid values. We don't want to go through the daemon
    # start-up functions for -V option.
    if (exists($opts{V})) {
        if (defined($opts{V})) {
            # For "-V variable:value", we check if the value is valid
            # for the variable. For "-V variable", we get the default
            # values for the variable
            $opts{V} = de_quote($opts{V});
            ($variable, $value) = split(':', $opts{V}, 2);
            if ($HATS_DBG{"main"}) {
                print STDERR "main(): -V $opts{V}=>KW=$variable, " .
                    "VAL=$value<=\n";
            }
            if (defined($value)) {
                $rc = hats_chk_values($variable, $value);
                $rc = -$rc;             # exit code should be [0..255].
                exit($rc);
            } else {
                if (hats_def_values($variable, $value) >= 0) {
                    print STDOUT "$value\n";
                    exit(0);
                } else {
                    exit(1);
                }
            }
        } else {
            # -V option is used interactively. All error messages are output to
            # STDERR. No need to make system log entries.
            #"Use: \"-V variable:value\" or \"-V variable\"\n"
            fatal_error(1, "EMSG687", "$SCRIPT");
        }
    }

    # 91966: AIX/Linux Interoperability
    # get_cluster_info() is an appropriate place to get the RSCT_Active_Version
    # since we need to use ct_clusterinfo, anyhow.  However, we need to know if
    # the version is preempted by a command line option so it must be checked
    # here.
    if ((exists($opts{l})) && (defined($opts{l}))) {
            $RSCTActiveVersion = $opts{l};
    } else {
            if (get_rsct_active_version($RSCTActiveVersion) == -1) {
                print_message("EMSG690", "$SCRIPT", "$DFLT_RAV_COMMAND");
            }
    }

    # Do the real work.

    if ($daemon_exec_opt) {
        print STDERR "$cmd_line\n";
    }

    # Cluster info is needed first.
    # get_cluster_info() will fill in the values for $cluster_name,
    # $cluster_id and $node_number.
    if (get_cluster_info($cluster_name, $cluster_id, $node_number) == -1) {
        ffdc_errlog("ERRID_TS_CL_CLINFO_ER", __LINE__, "ALPHA", "100", "-1"); 
        #"Could not get cluster information from $DFLT_CLUSTER_INFO.\n"
        fatal_error(1, "EMSG690", "$SCRIPT", "$DFLT_CLUSTER_INFO");
    }
    if ($HATS_DBG{"main"}) {
        print STDERR "main(): cluster_name=$cluster_name," .
            " cluster_id=$cluster_id, node_number=$node_number\n";
    }
    if ($daemon_exec_opt) {
        #print STDERR "Cluster: Name=$cluster_name, ID=$cluster_id, " .
        #    "Node number=$node_number\n";
        print_message("I_CthatsClusterInfo", "$cluster_name",
            "$cluster_id", "$node_number");
    }

    # $SUBSYSNAME is the subsystem name with cluster name extension in
    # multiple cluster/partition environments.
    $SUBSYSNAME = set_subsysname($SUBSYS, $cluster_name);

    $HB_DIR = "$DFLT_CLUSTER_DIR/$cluster_name";
    get_set_env($HB_DIR, $SUBSYS, $SUBSYSNAME);
    if ($HATS_DBG{"main"}) {
        print STDERR "HB_xxxx and FFDCxxxx environment variables:\n";
        foreach $i (keys %ENV) {
            if ($i =~ /^HB_|^FFDC/) {
                print STDERR "    $i=>$ENV{$i}\n";
            }
        }
    }
    $scriptLogFile = "$HB_LOGDIR/$SUBSYS.$cluster_name";

    SWITCH_MAINOPTS: {
        # build machines.lst
        if (exists($opts{b}) && $opts{b}) {
            hats_mach_lst_gen();
            if ($HB_MACH_LST_CMD ne "") {
                #print STDERR "Storing machines.lst using: " .
                #    "$HB_MACH_LST_CMD $HB_MACHINES_LIST\n";
                print_message("I_StoreMachLst",
                    "\"$HB_MACH_LST_CMD $HB_MACHINES_LIST\"");
                run_command("", "$HB_MACH_LST_CMD $HB_MACHINES_LIST", $rc);
                if ($rc) {
                    # ct_write_machines_lst returns 2 if there is no
                    # repository. It is not considered an error.
                    # Any non-0 exit code from $HB_MACH_LST_CMD
                    # programs is considered an error.
                    if (($HB_MACH_LST_CMD ne $DFLT_WRITE_MACH_LST) ||
                        ($rc != 2)) {
                        ffdc_errlog("ERRID_TS_REPOSITORY_ER", __LINE__,
                            "ALPHA,DEC", "96,4",
                            "$HB_MACH_LST_CMD $HB_MACHINES_LIST", $rc);
                        #"Unable to store Topology Services configuration 
                        #file $HB_MACHINES_LIST to repository using 
                        #\"$HB_MACH_LST_CMD $HB_MACHINES_LIST\". Exit code=$rc."
                        fatal_error(1, 
                            "EMSG850", "$SCRIPT", "$HB_MACHINES_LIST",
                            "\"$HB_MACH_LST_CMD $HB_MACHINES_LIST\"", "$rc");
                    }
                }
            }
            last SWITCH_MAINOPTS;
        }
        # refresh HATS subsystem
        if (exists($opts{r}) && $opts{r}) {
            #print STDERR "Refresh $SUBSYS. Reloading the configuration file\n";
            print_message("I_Refreshing", "$SUBSYS");
            load_machines_lst();
            set_net_option();
            $msg = join(' ', run_command("", "refresh -s $SUBSYS", $rc, 2));
            # The following message is the output of refresh command.
            # Print it directly.
            print STDERR $msg;
            if ($rc) {
                ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                    "ALPHA,DEC", "96,4", "refresh -s $SUBSYS", $rc);
                #"\"refresh -s $SUBSYS\" command exits with exit code=$rc"
                fatal_error(1, "EMSG871", "$SCRIPT",
                    "\"refresh -s $SUBSYS\"", "$rc");
            }
            last SWITCH_MAINOPTS;
        }
        # start HATS subsystem
        # "-N" is set when no main option is set. When no main option
        # is specified in the command line, this program performs the
        # default action, starting the HATS daemon.
        if ($daemon_exec_opt) {
            if (!chdir $HB_RUNDIR) {
                ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__,
                    "ALPHA", "100", $HB_RUNDIR);
                #"Cannot access directory $HB_RUNDIR"
                fatal_error(1, "EMSG865", "$SCRIPT", "$HB_RUNDIR");
            }
            log_core_cleanup();
    
            load_machines_lst();
            set_net_option();
    
            aix_runtime_options();
    
            if (exists($opts{n}) && $opts{n}) {
                # This message is for developer's use only. No NLS needed.
                print STDERR "Option -n used: not actually executing " .
                    "daemon.\n";
                script_log_management();
            } else {
                # Load DMS if we need to run the daemon.
                # Note: We need to load DMS even if we don't enable it.
                load_dms();
                $deadman_opt = (exists($opts{e}) && $opts{e})
                    ? " -o deadManSwitch" : "";
                if ($HATS_DBG{"main"}) {
                    print STDERR "main(): exec $RSCT_BIN/$DAEMON" .
                        " -n $node_number $deadman_opt\n";
                }

                # Configure the netmon library to allow pinging local
                # adapters with similar interface names:
                #   ALL_OTHERS: ping all other local adapters, regardless of
                #               type
                #   SAME_INTERFACE_TYPE: ping all other adapters that appear
                #               to have the same interface type -- there is
                #               a good chance they are in the same wire
                #   (default)   ping only those addresses passed by the daemon
                #               in the "open" request. In practice, this will
                #               be the local adaptrers that are on the same
                #               network as the local adapter being monitored.
                #               The caveat here is that these are the
                #               addresses as known by the daemon, which may
                #               not include cascading takeover addresses that
                #               may be in use.
                $ENV{'HA_NIM_NETMON_PING_LOCAL_ADAPTERS'} =
                                                       "SAME_INTERFACE_TYPE";

                #print STDERR "starting HATS daemon: $RSCT_BIN/$DAEMON " .
                #    "-n $node_number $deadman_opt\n";
                print_message("I_StartDaemon",
                    "\"$RSCT_BIN/$DAEMON -n $node_number $deadman_opt\"");
                script_log_management();
                # The "{" and "}" in next line is to avoid Perl complaints
                # about "statements after exec() are unreachable."
                {exec "$RSCT_BIN/$DAEMON -n $node_number $deadman_opt"};

                # The following statements are not executed unless the
                # above exec statement failed.
                $rc = get_exit_code($?);
                ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                    "ALPHA,DEC", "96,4",
                    "exec $RSCT_BIN/$DAEMON -n $node_number $deadman_opt", $rc);
                #"\"exec $RSCT_BIN/$DAEMON -n $node_number $deadman_opt\" 
                #command exits with exit code=$rc"
                fatal_error(1, "EMSG871", "$SCRIPT",
                    "\"exec $RSCT_BIN/$DAEMON -n $node_number $deadman_opt\"",
                    "$rc");
            }
            last SWITCH_MAINOPTS;
        }
    }           # end of SWITCH_MAINOPTS
    exit(0);    # exit 0 to make sure all exit values are defined.

#=======================================================================#
#                                                                       #
# Main program end                                                      #
#                                                                       #
#=======================================================================#

#=======================================================================#
#                                                                       #
# Subroutine: is_english_locale                                         #
# Description: Check if the current locale is English. Special locales  #
#     POSIX and C are considered English.                               #
# Note:                                                                 #
#       Since we use external command /usr/sbin/rsct/bin/ctdspmsg to    #
#       display messages. As an external command, ctdspmsg takes the    #
#       locale environment variables, which are set in %ENV. There is   #
#       actually no Perl locale setting used in this Perl script.       #
#       The locale environment variables are the ones that control the  #
#       behavior of message displaying.                                 #
# Return code:                                                          #
#       0 : current locale is not an English locale                     #
#       1 : current locale is an English locale                         #
#                                                                       #
#=======================================================================#

sub is_english_locale {
    local ($curr_locale);
    local ($rc);

    # Priority: LC_ALL > LC_MESSAGES > LANG > default ("C").
    $curr_locale = "C";
    if (exists($ENV{LANG}) && $ENV{LANG}) {
        $curr_locale = $ENV{LANG};
    }
    if (exists($ENV{LC_MESSAGES}) && $ENV{LC_MESSAGES}) {
        $curr_locale = $ENV{LC_MESSAGES};
    }
    if (exists($ENV{LC_ALL}) && $ENV{LC_ALL}) {
        $curr_locale = $ENV{LC_ALL};
    }
    # C and POSIX are considered English locales.
    if ($curr_locale eq "C" || $curr_locale eq "POSIX") {
        $rc = 1;
    } else {
        # Get first 2 characters and translate them into lower case.
        $curr_locale = substr($curr_locale, 0, 2);
        $curr_locale =~ tr/A-Z/a-z/;
        if ($curr_locale eq "en") {
            $rc = 1;
        } else {
            $rc = 0;
        }
    }
    return ($rc);
}

#=======================================================================#
#                                                                       #
# Subroutine: get_cat_msg                                               #
# Description: call /usr/sbin/rsct/bin/ctdspmsg to get NL messages from #
#       a specific locale.                                              #
# Input:                                                                #
#       locale: if locale is "", use the current locale settings in     #
#               locale environment variables to get the message.        #
#               if locale is not "", use locale to get the message from #
#               message catalog.                                        #
#       msg: the message label defined in message catalog and variable  #
#               number of arguments for the message.                    #
# Global:                                                               #
#       Locale environment variables.                                   #
#       MSGCMD: "/usr/sbin/rsct/bin/ctdspmsg script hats.cat"           #
#                                                                       #
#=======================================================================#

sub get_cat_msg {
    local ($locale, @msg) = @_;
    local ($command, $rc, $msg_string);

    # form command line for ctdspmsg command
    $command = "$MSGCMD " . join(' ', @msg);
    # use ctdspmsg command to get an NL message. 
    # We are using run_command() to get a message. It will cause recursive
    # call to this subroutine if run_command() prints a message. The 5'th
    # parameter, on_error, must be set to 0 to prevent run_command() from
    # printing any message.
    $msg_string = join('', run_command($locale, $command, $rc, 0, 0));
    if ($rc) {
        # $MSGCMD exits with an error. The message facility must be broken.
        # Use a hard-coded message for the error.
        $msg_string = "Cannot get message using: $command. Check if $MSGCMD " .
            "is executable and message map is up-to-date.\n";
    }
    return($msg_string);
}

#=======================================================================#
#                                                                       #
# Subroutine: print_message                                             #
# Description:                                                          #
#       Print NL messages. if $PRINT_ENG_MSG is true, print English     #
#       version also.                                                   #
# Input:                                                                #
#       message_label: the message label defined in message catalog.    #
#       argument: variable number of arguments for message.             #
# Global:                                                               #
#       Locale environment variables.                                   #
#       PRINT_ENG_MSG:                                                  #
#           0: print only NL message                                    #
#           1: print both NL and English message (for service personnel)#
#                                                                       #
#=======================================================================#

sub print_message {
    printf(STDERR "%s", get_cat_msg("", @_));
    if ($PRINT_ENG_MSG) {
        printf(STDERR "%s", get_cat_msg("C", @_));
    }
}

#=======================================================================#
#                                                                       #
# Function: argument_syntax_chk                                         #
# Description: Check if the syntax of the given command line options    #
#     are correct                                                       #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return:                                                               #
#     0 : successful                                                    #
#     1 : there are some syntax errors                                  #
# Global:                                                               #
#     %opts: option values.                                             #
#                                                                       #
#=======================================================================#

sub argument_syntax_chk {
    my ($ret);
    my ($syntax_err);
    local ($i);
    local ($main_opt);

    # option groups: h: help, b: build machines.lst e: execute daemon
    # "N" is not an option. It is set when no other main options exist,
    # which means to execute the daemon. All option groups are mutually
    # exclusive. Only the options in the same option group can be used
    # at the same time.
    %conflict_main_opts = (
        "h" => "bcCemMnNriItTvV",
        "b" => "ehnrNV",
        "e" => "bhnNriItTvV",
        "n" => "behNriItTvV",
        "N" => "behnriItTvV",
        "r" => "bcCehmMnNiItTvV",
        "V" => "bcCehmMnNriItTv");
    @conflict_upper_lower = ("c", "i", "t");
        
    $ret = getopts('bc:C:ehl:m:M:nri:I:t:T:vV:', \%opts);

    # Syntax checking
    if ($ret) {
        $syntax_err = 0;
    } else {
        # getopts() returns error for two cases:
        # 1. an unknown option is found. getopts() prints:
        #       "Unknown option: <option>"
        #    from inside the subroutine. We don't have to print anything.
        # 2. An option expects an argument but didn't get one. For example,
        #    instead of "cthats -i <hats info file>", the user only issue
        #    "cthats -i". -i expects an argument, but doesn't get one.
        #    getopts() returns "" and $opts{i} exists but its value is
        #    undefined.
        $syntax_err = 1;
        foreach $i (keys %opts) {
            if (! defined($opts{$i})) {
                #print STDERR "Option -$i needs an argument\n";
                print_message("EMSG683", "$SCRIPT", "-$i");
            }
        }
    }

    $syntax_err = 0;
    # All options should be parsed. Anything left is an error.
    if ($#ARGV != -1) {
         #print STDERR "Unrecognized command line options:";
         print_message("EMSG684", "$SCRIPT", join(', ', @ARGV));
         $syntax_err = 1;
    }

    # "N" stands for no other main options are used, which means to
    # execute the daemon.
    $main_opt = "";
    foreach $i (keys %conflict_main_opts) {
        if (exists($opts{$i})) {
            $main_opt = $i;
            last;
        }
    }
    if (! $main_opt) {
        $main_opt = "N";
        $opts{$main_opt} = 1;
    }

    # check conflicts between main option and other options.
    @conflict_opt = ();
    foreach $i (keys %opts) {
        if (defined($i) && $conflict_main_opts{$main_opt} =~ /$i/) {
            push(@conflict_opt, $i);
        }
    }
    if ($#conflict_opt >= 0) {
        #print STDERR "Option -$main_opt cannot co-exist with";
        print_message("EMSG685", "$SCRIPT", "-$main_opt", 
            "-" . join(', -', @conflict_opt));
        $syntax_err = 1;
    }
    # check conflicts between options providing the same information
    foreach $i (@conflict_upper_lower) {
        if (exists($opts{$i}) && exists($opts{uc($i)})) {
            #print STDERR "Option -$i cannot co-exist with -" . uc($i) . ".\n";
            print_message("EMSG685", "$SCRIPT", "-$i", "-" . uc($i));
            $syntax_err = 1;
        }
    }
    # check dependent options
    if (exists($opts{M}) && $opts{M} &&
        ! (exists($opts{m}) && $opts{m})) {
        #print STDERR "Option -M must be used with -m\n";
        print_message("EMSG686", "$SCRIPT", "-M", "-m");
        $syntax_err = 1;
    }

    return ($syntax_err);
}

#=======================================================================#
#                                                                       #
# Function: print_usage                                                 #
# Description: print the usage message                                  #
#              Un-supported options are not printed.                    #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub print_usage {

    #print STDERR "Usage:\n";
    #print STDERR "    cthats -h\n";
    #print STDERR "    cthats -b [-v]\n";
    #print STDERR "    cthats [-e | -n | -r]\n";
    #print STDERR "\n";
    #print STDERR "    options:\n";
    #print STDERR "    -b  build machines.lst\n";
    #print STDERR "    -e  starts cthats subsystem with Dead Man Switch " .
    #    "enabled.\n";
    #print STDERR "    -h  print usage message\n";
    #print STDERR "    -n  Do everything except for executing HATS daemon.\n";
    #print STDERR "    -r  refresh cthats subsystem\n";
    #print STDERR "    -v  verbose. print the contents of configuration " .
    #    "files in standard error\n";
    print_message("I_CthatsUsage", "$SCRIPT");
}

#=======================================================================#
#                                                                       #
# Function: get_cluster_info                                            #
# Description: get cluster name, cluster id,  and node number from the  #
#     command or text file specified by -c or -C option.                #
#                                                                       #
# Input: None                                                           #
# Output:                                                               #
#     cluster_name: cluster name                                        #
#     cluster_id: cluster ID                                            #
#     node_number: node number                                          #
# Return:                                                               #
#     0 : success                                                       #
#     -1: not success                                                   #
#                                                                       #
#=======================================================================#

sub get_cluster_info {
    local ($cluster_name, $cluster_id, $node_number);
    local (@ct_clusterinfo);
    local ($rc, $return_code);

    $return_code = 0;
    # Initialize important configuration variables.
    if (exists($opts{c}) && $opts{c}) {         # 1'st choice: -c
        if (-r $opts{c}) {
            @ct_clusterinfo = run_command("", "cat $opts{c}");
            push(@files_to_save_in_log, $opts{c});
        } else {
            if (-e $opts{c}) {
                #print STDERR "$opts{c} is not readable\n";
                print_message("EMSG867", "$SCRIPT", "$opts{c}");
            } else {
                #print STDERR "$opts{c} does not exist\n";
                print_message("EMSG866", "$SCRIPT", "$opts{c}");
            }
            $return_code = -1;
        }
    } elsif (exists($opts{C}) && $opts{C}) {    # 2'nd choice: -C
        @ct_clusterinfo = run_command("", "$opts{C}", $rc, 0, 1);
        if ($rc) {
            $return_code = -1;
        }
    } else {                                        # default: ct_clusterinfo
        @ct_clusterinfo = run_command("", "$DFLT_CLUSTER_INFO", $rc, 0, 1);
        if ($rc) {
            $return_code = -1;
        }
    }

    # We have cluster info in "standard" format. Parse it to get
    # cluster name, cluster ID, and port number.
    if ($return_code == 0) {
        chomp(@ct_clusterinfo);     # chop trailing '\n'
        foreach my $i (@ct_clusterinfo) {
            ($keyword, $keyvalue, $junk) = split(/[$SPACE_CHARS]+/, $i);
            if (defined($junk)) {
                # Use "\"$junk\"" because $junk may contain multiple words.
                #print STDERR "Extra value \"$junk\" found in the key value of keyword $keyword\n";
                print_message("EMSG692", "$SCRIPT", "\"$junk\"", "$keyword");
            }
            if (! defined($keyvalue) || ! $keyvalue) {
                $return_code = -1;
            } else {
                SWITCH_CT_CLUSTERINFO: {
                    if ($keyword eq "CLUSTER_NAME") {
                        $cluster_name = $keyvalue;
                        last SWITCH_CT_CLUSTERINFO;
                    }
                    if ($keyword eq "CLUSTER_ID") {
                        $cluster_id = $keyvalue;
                        last SWITCH_CT_CLUSTERINFO;
                    }
                    if ($keyword eq "NODE_NUMBER") {
                        $node_number = $keyvalue;
                        last SWITCH_CT_CLUSTERINFO;
                    }
                }   # end SWITCH_CT_CLUSTERINFO
            }
        }           # end foreach
    }
    if (($return_code == 0) && $cluster_name && $cluster_id && $node_number) {
        $_[0] = $cluster_name;
        $_[1] = $cluster_id;
        $_[2] = $node_number;
        #$ENV{"HA_DOMAIN_NAME"} = $cluster_name;
    } else {
        $return_code = -1;
    }
    if ($HATS_DBG{"get_cluster_info"}) {
        print STDERR "get_cluster_info(): cluster_name=$cluster_name, " .
            "cluster_id=$cluster_id, node_number=$node_number\n";
    }
    return ($return_code);
}

# 91966: AIX/Linux Interoperability
#=======================================================================#
#                                                                       #
# Function: get_rsct_active_version                                     #
# Description: Retrieve the RSCT Active Version number                  #
#                                                                       #
# Input: None                                                           #
#                                                                       #
# Output:                                                               #
#     RSCTActiveVersion: The version number is returned through the     #
#                        first parameter passed to the function         #
# Return:                                                               #
#     0 : success                                                       #
#     -1: not success                                                   #
#                                                                       #
#=======================================================================#
sub get_rsct_active_version {
    local ($RSCTActiveVersion);
    local (@version);
    local ($rc, $return_code);

    $return_code = 0;
    @version = run_command("", "$DFLT_RAV_COMMAND", $rc, 0, 1);
    if ($rc) {
        $return_code = -1;
    } else {
        ($RSCTActiveVersion) = @version;
        chomp($RSCTActiveVersion);
        $_[0] = $RSCTActiveVersion;
    }
    return ($return_code);
}


#=======================================================================#
#                                                                       #
# Function: set_subsysname                                              #
# Description: Find out if need to append the cluster/partition name to #
#     the subsystem name. On machines need to run multiple HATS,        #
#     e.g. SP control workstation, we add the partition name to HATS    #
#     subsystem name to distinguish them. $SUBSYSNAME equals to         #
#     $SUBSYS.partion_name. On other systems, $SUBSYSNAME=$SUBSYS.      #
#                                                                       #
#     Usage of $SUBSYS, $SUBSYSNAME, and $SUBSYS.$cluster_name:         #
#     $SUBSYS:                                                          #
#         FFDC error messages                                           #
#         HB_SERVICE_NAME environment variable                          #
#     $SUBSYSNAME:                                                      #
#         HB_SUBSYS_NAME environment variable                           #
#         log/run/soc directory names                                   #
#     $SUBSYS.$cluster_name:                                            #
#         script log file names                                         #
#         daemon log file names                                         #
#                                                                       #
# Input:                                                                #
#     subsys : base subsystem name                                      #
#     cluster_name : cluster name                                       #
# Output: None                                                          #
# Return:                                                               #
#     A string to be assigned to $SUBSYSNAME variable.                  #
#                                                                       #
#=======================================================================#

sub set_subsysname {
    # Multiple cluster environment is not supported. 
    return($SUBSYS);
}

#=======================================================================#
#                                                                       #
# Function: get_set_env                                                 #
# Description: Get HATS configuration environment variables. Set these  #
#     environment variables if the command line options override them.  #
#     The affected environment variables include:                       #
#         HB_SUBSYS_NAME : used by daemon to determine subsystem name   #
#         HB_SERVICE_NAME : used for obtaining service name/port number #
#             in /etc/services                                          #
#         HB_SOCKET : HATS port number. This variable is used only when #
#             HB_SERVICE_NAME is not used.                              #
#         HB_LOGDIR : path of HATS log directory                        #
#         HB_RUNDIR : path of HATS run directory                        #
#         HB_SERVER_SOCKET : path of HATS socket. It also implies the   #
#             HATS socket directory                                     #
#         HB_SOCKETDIR : path of HATS socket directory. This variable   #
#             is introduced for the pluggable NIM. It may conflict with #
#             HB_SERVER_SOCKET. Before we stop using HB_SERVER_SOCKET,  #
#             we need to check the consistancy between these environment#
#             variables.                                                #
#         HB_MACHINES_LIST : path of HATS configuration file machines.lst#
#         HB_CTKF_PATH : path of HATS cluster shared secret key file    #
#                                                                       #
#     Note that HATS configuration environment variables may change the #
#     behavior of HATS daemon. We need to turn off or assign the        #
#     official values for all HATS configuration related environment    #
#     variables in official environment, i.e. this program is called    #
#     by the official name "cthats".                                    #
#                                                                       #
#     The default value of HB_LOGDIR and HB_RUNDIR used in hats daemon  #
#     are for PSSP environment. We need to assign them the new cluster  #
#     default values.                                                   #
#                                                                       #
# Input:                                                                #
#     hb_dir : default HATS root directory                              #
#     subsys : HATS subsystem name                                      #
#     subsysname : HATS subsystem name (with partition name in PSSP)    #
#                                                                       #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub get_set_env {
    local ($hb_dir, $subsys, $subsysname) = @_;
    local ($to_read_mach_lst);
    local ($rc);

    # used by daemon to determine subsystem name.
    $ENV{"HB_SUBSYS_NAME"} = $SUBSYS;

    # HATS entry in /etc/services.
    $ENV{"HB_SERVICE_NAME"} = $SUBSYS;
    if ("$subsys" eq "$OFFICIAL_NAME") {
        # HATS port number. Should be specified in /etc/services.
        delete $ENV{"HB_SOCKET"};
    }

    # set up log directory
    if (("$SUBSYS" eq "$OFFICIAL_NAME") || (! $ENV{"HB_LOGDIR"})) {
        $HB_LOGDIR = "$hb_dir/log/$subsysname";
        $ENV{"HB_LOGDIR"} = "$HB_LOGDIR/";
    } else {
        $HB_LOGDIR = $ENV{"HB_LOGDIR"};
    }
    if ( ! -d $HB_LOGDIR) {
        # Use mkdir command instead of Perl mkdir function for '-p' option
        # "mkdir -p" exits with 0 when the directory exists.
        run_command("", "mkdir -p $HB_LOGDIR", $rc);
        if ($rc) {
            ffdc_errlog("ERRID_TS_SP_DIR_ER", __LINE__, "ALPHA", "100",
                $HB_LOGDIR);
            #"Cannot create directory $HB_LOGDIR"
            fatal_error(1, "EMSG603", "$SCRIPT", "$HB_LOGDIR");
        }
    }

    # Set path name for key file in environment
    $ENV{"HB_CTKF_PATH"} = "$DFLT_CLUSTER_DIR/$cluster_id/cfg/ct_cssk.kf";

    # Make sure we have full access to the log directory.
    # For developers:
    #   Use chmod command instead of Perl chmod function because Perl
    #   chmod function does not support "u+rwx" in mode.
    #   We would like to check if $HB_LOGDIR has required access mode before
    #   changing it. However, Perl file testing functions, e.g. -r, always
    #   return TRUE for superusers. We have to use more complicated stat()
    #   function to resolve this problem. It is not worthy to do it for now.
    run_command("", "chmod 0755 $HB_LOGDIR", $rc, 1);

    # set up run directory
    if (("$SUBSYS" eq "$OFFICIAL_NAME") || (! $ENV{"HB_RUNDIR"})) {
        $HB_RUNDIR = "$hb_dir/run/$subsysname";
        $ENV{"HB_RUNDIR"} = "$HB_RUNDIR/";
    } else {
        $HB_RUNDIR = $ENV{"HB_RUNDIR"};
    }
    if ( ! -d $HB_RUNDIR) {
        # Use mkdir command instead of Perl mkdir function for '-p' option
        # "mkdir -p" exits with 0 when the directory exists.
        run_command("", "mkdir -p $HB_RUNDIR", $rc);
        if ($rc) {
            ffdc_errlog("ERRID_TS_SP_DIR_ER", __LINE__, "ALPHA", "100",
                $HB_RUNDIR);
            #"Cannot create directory $HB_RUNDIR"
            fatal_error(1, "EMSG603", "$SCRIPT", "$HB_RUNDIR");
        }
    }
    # Make sure we have full access to the run directory.
    run_command("", "chmod 0755 $HB_RUNDIR", $rc, 1);

    # set up soc directory
    if (("$SUBSYS" eq "$OFFICIAL_NAME") ||
        (! ($ENV{"HB_SOCKETDIR"} || $ENV{"HB_SERVER_SOCKET"}))) {
        $HB_SOCKETDIR = "$hb_dir/soc/$subsysname";
        $ENV{"HB_SOCKETDIR"} = $HB_SOCKETDIR;
        $ENV{"HB_SERVER_SOCKET"} = "$HB_SOCKETDIR/server_socket";
    } else {
        # Non-official environment and $ENV{"HB_SOCKETDIR"} or
        # $ENV{"HB_SERVER_SOCKET"} is set. Use them to find HB_SOCKETDIR.
        # $ENV{"HB_SOCKETDIR"} has higher priority than 
        # $ENV{"HB_SERVER_SOCKET"}.
        if ($ENV{"HB_SOCKETDIR"}) {
            $HB_SOCKETDIR = $ENV{"HB_SOCKETDIR"};
            $ENV{"HB_SERVER_SOCKET"} = "$HB_SOCKETDIR/server_socket";
        } else {
            ($HB_SOCKETDIR, $junk) =
                split(/\/$subsysname\//, $ENV{"HB_SERVER_SOCKET"});
            $HB_SOCKETDIR = "$HB_SOCKETDIR/$subsysname";
            $ENV{"HB_SOCKETDIR"} = $HB_SOCKETDIR;
        }
    }
    if ( ! -d $HB_SOCKETDIR) {
        # Use mkdir command instead of Perl mkdir function for '-p' option
        # "mkdir -p" exits with 0 when the directory exists.
        run_command("", "mkdir -p $HB_SOCKETDIR", $rc);
        if ($rc) {
            ffdc_errlog("ERRID_TS_SP_DIR_ER", __LINE__, "ALPHA", "100",
                $HB_SOCKETDIR);
            #"Cannot create directory $HB_SOCKETDIR"
            fatal_error(1, "EMSG603", "$SCRIPT", "$HB_SOCKETDIR");
        }
    }
    # Make sure we have full access to the socket directory.
    # Sockets aren't world readable.
    run_command("", "chmod 0750 $HB_SOCKETDIR", $rc, 1);

    # HB_MACHINES_LIST and -m and -M option
    # Traditional default hats behavior is to load and store
    # machines.lst file from/to repository automatically.
    # To avoid loading/storing repository, use empty -M option.
    # i.e.: -M "".
    $to_read_mach_lst = (exists($opts{e}) && $opts{e}) ||
        (exists($opts{n}) && $opts{n}) ||
        (exists($opts{N}) && $opts{N}) ||
        (exists($opts{r}) && $opts{r});
    if (exists($opts{m})) {
        if ($to_read_mach_lst) {
            $HB_MACHINES_LIST =
                ($opts{m}) ? $opts{m} : "$HB_RUNDIR/$DFLT_MACHINES_LST";
            if (! -r $HB_MACHINES_LIST) {
                ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__,
                    "ALPHA", "100", "$HB_RUNDIR/$DFLT_MACHINES_LST");
                if (-e $HB_MACHINES_LIST) {
                    #File $HB_MACHINES_LIST is not readable."
                    fatal_error(1, "EMSG867", "$SCRIPT", "$HB_MACHINES_LIST");
                } else {
                    #"File $HB_MACHINES_LIST does not exist"
                    fatal_error(1, "EMSG866", "$SCRIPT", "$HB_MACHINES_LIST");
                }
            } else {
                $ENV{"HB_MACHINES_LIST"} = $HB_MACHINES_LIST;
                push(@files_to_save_in_log, $HB_MACHINES_LIST);
            }
            if (exists($opts{M}) && (! $opts{M})) {
                # Do not load/store repository.
                $HB_MACH_LST_CMD = "";
            } else {
                $HB_MACH_LST_CMD =
                    ($opts{M}) ? $opts{M} : "$DFLT_READ_MACH_LST";
            }
        } else {
            $HB_MACHINES_LIST = $opts{m};
            if ($opts{m}) {
                $HB_MACH_LST_CMD = (exists($opts{M})) ? $opts{M} : "";
            } else {
                # Do not load/store repository.
                $HB_MACH_LST_CMD = "";
            }
        }
    } else {
        if (("$SUBSYS" eq "$OFFICIAL_NAME") || (! $ENV{"HB_MACHINES_LIST"})) {
            $HB_MACHINES_LIST = "$HB_RUNDIR/$DFLT_MACHINES_LST";
            if ($to_read_mach_lst) {
                $ENV{"HB_MACHINES_LIST"} = $HB_MACHINES_LIST;
            }
        } else {
            $HB_MACHINES_LIST = $ENV{"HB_MACHINES_LIST"};
        }
        $HB_MACH_LST_CMD =
            ($to_read_mach_lst) ? $DFLT_READ_MACH_LST : $DFLT_WRITE_MACH_LST;
    }
    if ($HB_MACH_LST_CMD && (! -x path_search($HB_MACH_LST_CMD))) {
        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
            "$HB_MACH_LST_CMD");
        if ( -e path_search($HB_MACH_LST_CMD)) {
            # Use "\"$HB_MACH_LST_CMD\"" because $HB_MACH_LST_CMD may
            # contain multiple words.
            #"Command \"$HB_MACH_LST_CMD\" is not executable"
            fatal_error(1, "EMSG869", "$SCRIPT", "\"$HB_MACH_LST_CMD\"");
        } else {
            #"File $HB_MACH_LST_CMD does not exist"
            fatal_error(1, "EMSG866", "$SCRIPT", "$HB_MACH_LST_CMD");
        }
    }
    if ($HATS_DBG{"get_set_env"}) {
        print STDERR "get_set_env(): HB_LOGDIR=$HB_LOGDIR, " .
            "HB_RUNDIR=$HB_RUNDIR, HB_SOCKETDIR=$HB_SOCKETDIR, " .
            "HB_MACHINES_LIST=$HB_MACHINES_LIST, " .
            "HB_MACH_LST_CMD=$HB_MACH_LST_CMD, " .
            "HB_CTKF_PATH=$ENV{HB_CTKF_PATH}\n";
    }
}

#=======================================================================#
#                                                                       #
# Function: load_machines_lst                                           #
# Description: Load the HATS configuration file machines.lst to the     #
#     HB_RUNDIR directory before starting or refreshing HATS.           #
#     The program first try to load machines.lst from the repository.   #
#     If there is no repostitory and we are running in the scaffold     #
#     environment, we use the output of ct_hats_info and                #
#     ct_topology_info to generate a machines.lst file.                 #
#                                                                       #
#     Not being able to load machines.lst file is fatal to HATS. We     #
#     use fatal_error() to exit. Hence there is no return code for      #
#     this subroutine.                                                  #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub load_machines_lst {
    local ($rc);

    if ($HB_MACH_LST_CMD) {
        # Load machines.lst file from the repository.
        #print STDERR "Loading machines.lst using: 
        #    \"$HB_MACH_LST_CMD $HB_MACHINES_LIST\"\n";
        print_message("I_LoadMachLst", "\"$HB_MACH_LST_CMD $HB_MACHINES_LIST\"");
        run_command("", "$HB_MACH_LST_CMD $HB_MACHINES_LIST", $rc);
        if ($HATS_DBG{"load_machines_lst"}) {
            print STDERR "Run $HB_MACH_LST_CMD $HB_MACHINES_LIST gets $rc\n";
        }
        if ($rc) {
            # ct_read_machines_lst returns 2 if there is no
            # repository. We need to generate machines.lst.
            # All other non-0 exit codes are considered an error.
            if (($HB_MACH_LST_CMD ne $DFLT_READ_MACH_LST) ||
                ($rc != 2)) {
                ffdc_errlog("ERRID_TS_REPOSITORY_ER", __LINE__,
                    "ALPHA,DEC", "96,4",
                    "$HB_MACH_LST_CMD $HB_MACHINES_LIST", $rc);
                #"Unable to retrieve Topology Services configuration file
                #$HB_MACHINES_LIST from repository using
                #\"$HB_MACH_LST_CMD $HB_MACHINES_LIST\". Exit code=$rc."
                fatal_error(1, "EMSG851", "$SCRIPT", "$HB_MACHINES_LIST",
                    "\"$HB_MACH_LST_CMD $HB_MACHINES_LIST\"", "$rc");
            } else {
                # This happens only in scaffold environment
                # Setup control variables to call "build-machines.lst"
                # function internally. These options should not be
                # set otherwise the argument_syntax_chk() should have
                # found them conflict with other options.
                # The following options forces the "build-machines.lst"
                # function to use the output of ct_hats_info and
                # ct_topology_info to generate a machines.lst file
                # without writting it into the repository.
                $opts{I} = $DFLT_HATS_INFO;
                $opts{T} = $DFLT_TOPOLOGY_INFO;
                $opts{m} = $HB_MACHINES_LIST;
                hats_mach_lst_gen();
            }
        } else {
            # Load machines.lst file from the repository successfully.
            push(@files_to_save_in_log, $HB_MACHINES_LIST);
        }
    } else {
        # It is also possible that someone has already put a machines.lst
        # file in the location described by -m option. We only need to check
        # if it is readable.
        if (-r $HB_MACHINES_LIST) {
            push(@files_to_save_in_log, $HB_MACHINES_LIST);
        } else {
            ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__,
                "ALPHA", "100", "$HB_RUNDIR/$DFLT_MACHINES_LST");
            #"File $HB_MACHINES_LIST is not readable"
            fatal_error(1, "EMSG867", "$SCRIPT", "$HB_MACHINES_LIST");
        }
    }
    # If security is shown to be on, confirm it by locating keyfile
    # and checking that it is valid.
    # Feature 77300
    run_command("", "grep '^*!HaTsSeCStatus=on' $HB_MACHINES_LIST", $rc);
    if ($rc == 0) {
        $conf_sec = get_security_status();          # Feature 77300
        if ($conf_sec eq "error") {
            ffdc_errlog("ERRID_TS_KEYFILE_ER", __LINE__, "ALPHA", "100",
                $ENV{HB_CTKF_PATH});
            #"Keyfile $ENV{\"HB_CTKF_PATH\"} present but corrupt."
            fatal_error(1, "EMSG667", "$SCRIPT", "$ENV{\"HB_CTKF_PATH\"}");
        }
    }
}

#=======================================================================#
#                                                                       #
# Function: set_net_option                                              #
# Description: Set required network options to enable source routing.   #
#    Source routing is required to support Reliable Messaging.          #
#    This is operating system specific function.                        #
#    In AIX, /usr/sbin/no command can be used to set network options.   #
#    In Linux, various files in /proc/sys/net/ipv4/ can be used to set  #
#    network options.                                                   #
#    The following are required to enable source routing in Linux:      #
#    1. Turn on "IP forwarding" by:                                     #
#        echo 1 > /proc/sys/net/ipv4/ip_forward                         #
#                                                                       #
#    2. Turn off "reversed path source validation" by:                  #
#        echo 0 > /proc/sys/net/ipv4/conf/all/rp_filter                 #
#        echo 0 > /proc/sys/net/ipv4/conf/<device>/rp_filter            #
#                                                                       #
#    3. Turn on "accepting source routing packets" by:                  #
#        echo 1 > /proc/sys/net/ipv4/conf/all/accept_source_route       #
#        echo 1 > /proc/sys/net/ipv4/conf/<device>/accept_source_route  #
#                                                                       #
# Note: Since we need to parse machines.lst to find the network adapter #
#     names for source routing, this subroutine should be called after  #
#     load_machines_lst().                                              #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub set_net_option {
    local ($NET_NAME_SUBST, $IPV4_OPT_DIR, %net_options);
    local (@configed_net, %configed_net_hash);
    local ($interface, $net_opt_error, $option_val);
    local ($i, $j, $junk);

    if ("$SYS_SYSNAME" eq "Linux") {
        # Linux uses /proc/sys/net/ipv4/ to set network options.

        # If a keyword of %net_options contains $NET_NAME_SUBST ("%N"),
        # e.g. $IPV4_OPT_DIR/conf/$NET_NAME_SUBST/rp_filter, we will 
        # expand it by substituting $NET_NAME_SUBST with all existing
        # network adapters. For example, if we have lo, eth0, and tr0,
        # $IPV4_OPT_DIR/conf/$NET_NAME_SUBST/rp_filter will be expanded to
        # $IPV4_OPT_DIR/conf/lo/rp_filter, $IPV4_OPT_DIR/conf/eth0/rp_filter,
        # and $IPV4_OPT_DIR/conf/tr0/rp_filter.
        $NET_NAME_SUBST = "%N";
        # Developer's note: Change $IPV4_OPT_DIR to other place to test
        # the code if you don't want to ruin /proc/sys/net/ipv4/.
        #$IPV4_OPT_DIR = "/tmp/proc_ipv4";
        $IPV4_OPT_DIR = "/proc/sys/net/ipv4";
        %net_options = (
            "$IPV4_OPT_DIR/ip_forward" => 1,
            "$IPV4_OPT_DIR/conf/$NET_NAME_SUBST/rp_filter" => 0,
            "$IPV4_OPT_DIR/conf/$NET_NAME_SUBST/accept_source_route" => 1
        );

        #
        # We only enable source routing for the network adapters used by 
        # Topology Services.
        %configed_net_hash = ();
        $source_routing = 0;
        open(FP, "< $HB_MACHINES_LIST");
        while (<FP>) {
            chomp;              # Remove trailing '\n'
            # Looking for network name line. e.g. "Network Name en_net_0".
            if (/^Network Name/) {
                # Source routing is per-network. Reset to default (0) at
                # beginning of each network session.
                if ($HATS_DBG{"set_net_option"}) {
                    print STDERR "set_net_option(): Reset source_routing for " .
                        $_ . "\n";
                }
                $source_routing = 0;
            }
            # Looking for source routing line. e.g. "*!NIM_Src_Routing=1".
            # The format of NIM_Src_Routing line is: "*!NIM_Src_Routing="
            # followed by 0 or more spaces followed by 0 or 1 "-" followed by
            # 1 or more numeric characters.
            if (/^\*!NIM_Src_Routing=/) {
                s/(^\*!NIM_Src_Routing= *)(-?[0-9]+)(.*$)/$2/;
                # Do not turn on source routing for -1(default) and 0(off).
                if ($_ > 0) {
                    $source_routing = 1;
                }
                if ($HATS_DBG{"set_net_option"}) {
                    print STDERR "set_net_option(): parse *!NIM_Src_Routing=" .
                        $_ . "($source_routing)\n";
                }
            }
            # Looking for my adapter lines. e.g. "    2 eth0 9.114.67.72".
            # The regular expression matches: one or more spaces followed
            # by a node number followed by one or more spaces followed by 
            # a full adapter name followed by one or more spaces followed 
            # by an IP address.
            # Since $node_number is the node number of the node that is
            # running this script, the following regular expression will
            # only match the network adapters on the node that is running
            # this script.
            if ($source_routing &&
                /^ +$node_number +$PAT_ADAPTER_FULL +$PAT_IP_ADDRESS/) {
                # Since the first character is a space, ^ is the first,
                # node number is the 2'nd and interface name is the 3'rd
                # element returned by split().
                ($junk, $junk, $interface, $junk) = split(/[$SPACE_CHARS]+/);
                # Get base network interface name if it is an alias interface.
                ($interface, $junk) = split(/:/, $interface);
                $configed_net_hash{$interface} = 1;
            }
        }
        close(FP);

        @configed_net = keys %configed_net_hash;
        if ($#configed_net >= 0) {
            # Special network "all" is the global setting of all networks.
            # "all" needs to be turned on, too. We put it in the beginning
            # of @configed_net so that it will be turned on before others.
            @configed_net = ("all", @configed_net);
            if ($HATS_DBG{"set_net_option"}) {
                print STDERR "set_net_option(): Turn on source routing for: " .
                    join(",", @configed_net) . "\n";
            }
            # Linux network options can be configured at the kernel compilation 
            # time. The files we need may not exist or be changeable.
            $net_opt_error = 0;
            foreach $i (keys %net_options) {
                $option_val = $net_options{$i};
                if ($i =~ m/$NET_NAME_SUBST/) {
                    # Substituting $NET_NAME_SUBST with network adapter names.
                    foreach $j (@configed_net) {
                        $net_option = $i;
                        $net_option =~ s/$NET_NAME_SUBST/$j/;
                        if (set_verify_option($net_option, $option_val) < 0) {
                            $net_opt_error++;
                        }
                    }
                } else {
                    if (set_verify_option($i, $option_val) < 0) {
                        $net_opt_error++;
                    }
                }
            }
            if ($net_opt_error > 0) {
                #print STDERR "Required network options are not set " .
                #    "correctly.\nSource routing may not work properly.\n";
                print_message("EMSG675", "$SCRIPT");
            }
        }
    } elsif ("$SYS_SYSNAME" eq "AIX") {
        # Only set network options if source routing is set
        # for any of the adapters.
        $source_routing = 0;
        open(FP, "< $HB_MACHINES_LIST");
        while (<FP>) {
            chomp;              # Remove trailing '\n'
            if (/^\*!NIM_Src_Routing=/) {
                s/(^\*!NIM_Src_Routing= *)(-?[0-9]+)(.*$)/$2/;
                # Do not turn on source routing for -1(default) and 0(off).
                if ($_ > 0) {
                    $source_routing = 1;
                }
                if ($HATS_DBG{"set_net_option"}) {
                    print STDERR "set_net_option(): parse *!NIM_Src_Routing=" .
                        $_ . "($source_routing)\n";
                }
            }
        }
        close(FP);
        if ($source_routing) {
            # AIX uses /usr/sbin/no command to set network options.
            run_command("", "no -o nonlocsrcroute=1 -o ipsrcroutesend=1 " .
                "-o ipsrcrouterecv=1 -o ipsrcrouteforward=1");
        }
    } else {
        # We should have exited from inside hats_chk_values_init()
        # if $SYS_SYSNAME is not supported.
    }
}

#=======================================================================#
#                                                                       #
# Function: set_verify_option                                           #
# Description: Set value to a kernel option using /proc filesystem and  #
#     read back the value to verify if it is set correctly.             #
#     This is a Linux specific subroutine.                              #
#     Many Linux options can be configured at the compilation time.     #
#     The files we want to change may not exist or changeable.          #
#                                                                       #
# Input:                                                                #
#     option_name: The Linux option file name in /proc filesystem.      #
#     option_val: The value to be set to the option.                    #
#                                                                       #
# Output: None                                                          #
# Return:                                                               #
#     0 : option is set to the given value                              #
#     -1: error                                                         #
#                                                                       #
#=======================================================================#

sub set_verify_option {
    local ($option_name, $option_val) = @_;
    local (@read_back);
    local ($return_code);

    if ($HATS_DBG{"set_verify_option"}) {
        print STDERR "set_verify_option(): Setting $option_name to $option_val\n";
    }
    $return_code = 0;
    if (-e $option_name) {
        if (open(FP, "> $option_name")) {
            print FP "$option_val\n";
            close(FP);
            @read_back = ();
            if (open(FP, "< $option_name")) {
                @read_back = <FP>;
                close(FP);
                chomp(@read_back);
            }
            if (($#read_back < 0) ||
                ($read_back[0] != $option_val)) {
                # Use "\"$option_val\"" because $option_val may
                # contain multiple words.
                #print STDERR "Cannot set system option $option_name to
                #    $option_val.\n";
                print_message("EMSG677", "$SCRIPT", "$option_name",
                    "\"$option_val\"");
                $return_code = -1;
            }
        } else {
            #print STDERR "Cannot access system option $option_name.\n";
            print_message("EMSG676", "$SCRIPT", "$option_name");
            $return_code = -1;
        }
    } else {
        #print STDERR "Cannot access system option $option_name.\n";
        print_message("EMSG676", "$SCRIPT", "$option_name");
        $return_code = -1;
    }
    return ($return_code);
}

#=======================================================================#
#                                                                       #
# Function: load_dms                                                    #
# Description: Check if the Dead Man Switch is loaded. Load it if it is #
#     not loaded or the loaded DMS version is too old.                  #
#                                                                       #
#     Currently, DMS is only supported in AIX.                          #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub load_dms {
    local ($rc);

    if ("$SYS_SYSNAME" eq "AIX") {
        run_command("", "$RSCT_BIN/haDMS/haDMS_query", $rc, 1);
        if ($rc) {
            #print STDERR "DMS kernel extension not loaded or has an " .
            #    "older version.\n";
            #print STDERR "Loading DMS kernel extension.\n";
            print_message("EMSG626", "$SCRIPT");
            $msg = join(' ', run_command("",
                "$RSCT_BIN/haDMS/haDMS_load $RSCT_BIN/haDMS/haDMS_kex",
                $rc, 2, 0));
            if ($rc) {
                # The following message is produced by DMS in the current
                # locale. Print it out directly.
                print STDERR "$msg";
                ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                    "ALPHA,DEC", "96,4",
                    "$RSCT_BIN/haDMS/haDMS_load $RSCT_BIN/haDMS/haDMS_kex",
                    $rc);
                #"\"$RSCT_BIN/haDMS/haDMS_load $RSCT_BIN/haDMS/haDMS_kex\"
                #command exits with exit code=$rc"
                fatal_error(1, "EMSG871", "$SCRIPT",
                    "\"$RSCT_BIN/haDMS/haDMS_load $RSCT_BIN/haDMS/haDMS_kex\"",
                    "$rc");
            }
        }
    }
}

#=======================================================================#
#                                                                       #
# Function: aix_runtime_options                                         #
# Description: Setup some runtime options needed in the AIX             #
#     environment.                                                      #
#                                                                       #
#     Currently the following options are used:                         #
#         - force pthreads library to use 1-1 kernel/user mapping       #
#         - reduce the memory allocated for "virtual processors"        #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub aix_runtime_options {
    local ($rc);

    if ("$SYS_SYSNAME" eq "AIX") {

        # Force 1-1 mapping between user and kernel threads
        # The HATS daemon already has code to create threads using an
        # 1-1 mapping, but the main thread would still have "process scope".
        # The statement below changes that.
        $ENV{"AIXTHREAD_SCOPE"} = "S";

        # In AIX 5.1 memory is used in the threads library for
        # "virtual processors". Since HATS adopts the 1-1 mapping between
        # user and kernel threads, it does not need the virtual processors.
        # The statement below helps save around 2Mb for the daemon and
        # each NIM.
        $ENV{'NUM_SPAREVP'} = "1";

        # Load the kernel extension that allows the daemon to pin its
        # memory areas
        run_command("", "$RSCT_BIN/pin/hatspin_load", $rc, 1, 1);
    }
}


#########################################################################
#                                                                       #
# FFDC related                                                          #
#                                                                       #
#########################################################################

#=======================================================================#
#                                                                       #
# Function: call_ffdcinit                                               #
# Description: As of Nov. 1999, FFDC initialization is supported in     #
#     shell and C-shell scripts only. This subroutine performs the      #
#     same function that fcinit.*sh do.                                 #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Global:                                                               #
#     FFDC environment variables are added to %ENV.                     #
#                                                                       #
#=======================================================================#

sub call_ffdcinit {
    local ($ffdcenv, $key, $value);
    local ($i, $rc);

    if ( -x $FFDC_FCINIT) {
        @ffdcenv = run_command("", "$FFDC_FCINIT -n$$ -p$SUBSYS", $rc);
        SWITCH_FFDC_RC: {
            # 0: FFDC Environment created, 1: FFDC Environment inherited
            if (($rc == 0) || ($rc == 1)) {
                if ($HATS_DBG{"call_ffdcinit"}) {
                    print STDERR "call_ffdcinit(): FFDC Environment " .
                        ($rc) ? "inherited\n" : "created\n";
                }
                chomp(@ffdcenv);    # remove trailing "\n"
                foreach $i (@ffdcenv) {
                    ($key, $value) = split('=', $i);
                    $ENV{"$key"} = $value;
                    if ($HATS_DBG{"call_ffdcinit"}) {
                        print STDERR "call_ffdcinit(): Set environment " .
                            "variable $key to =>$value<=\n";
                    }
                }
                last SWITCH_FFDC_RC;
            }

            # 2: a help message was generated
            if ($rc == 2) {
                # Do not use ffdc_errlog() here because FFDC is not yet active.

                # The following message is produced by $FFDC_FCINIT in
                # the current locale. Print it out directly.
                print STDERR "@ffdcenv\n";
                #"\"$FFDC_FCINIT -n$$ -p$SUBSYS\" command exits with
                #exit code=$rc"
                fatal_error(1, "EMSG871", "$SCRIPT",
                    "\"$FFDC_FCINIT -n$$ -p$SUBSYS\"", "$rc");
                last SWITCH_FFDC_RC;
            }
            # All other exit codes indicate an error.

            # Do not use ffdc_errlog() here because FFDC is not yet active.

            # FFDC is not yet supporter on IA64. Ignore the exit code for IA64.
            if ($SYS_MACHINE ne "ia64") {
                #"Can not initialize FFDC environment, return code = $rc"
                fatal_error(1, "EMSG601", "$SCRIPT", "$rc");
            }
        }   # end SWITCH_FFDC_RC
    }
}

#=======================================================================#
#                                                                       #
# Function: ffdc_errlog                                                 #
# Description: add an entry to the FFDC error log using fclogerr command#
#                                                                       #
#     fclogerr parameters are as follows:                               #
#         $template: template id in hats.err.E                          #
#         $lineno: line number where the error was found (use __LINE__ )#
#         $event_type: error log type (derived from template id)        #
#             possible values: INFO, UNKN, PERM, TEMP, PEND, PERF       #
#         $types: types used for the detailed data.                     #
#             Example: "DEC,ALPHA"                                      #
#             Must match the template in hats.err.E                     #
#             "" indicates that no detailed data is present             #
#         $sizes: sizes for each item in the detailed data              #
#             Example: "4,96"                                           #
#             Must match the template in hats.err.E                     #
#         $data: detailed data: a string with "," separating each       #
#             item                                                      #
#             Example: "$rc,$filename"                                  #
#                                                                       #
# Input:                                                                #
#     $template: template id in hats.err.E. Passed to fclogerr directly.#
#         The $event_type of fclogerr can be determined by the last two #
#         characters of $template                                       #
#     $lineno: line number where the error was found (use __LINE__ )    #
#         Passed to fclogerr directly.                                  #
#     $types: types used for the detailed data. Passed to fclogerr      #
#         directly.                                                     #
#     $sizes: sizes for each item in the detailed data separated by ',' #
#         Passed to fclogerr directly.                                  #
#     @det_data: a list of detailed data. ',' in data will be replaced  #
#         with '.' to avoid confusing fclogerr.                         #
#                                                                       #
# Output: None                                                          #
# Return:                                                               #
#     The exit code of fclogerr command.                                #
#                                                                       #
#=======================================================================#

sub ffdc_errlog {
    my ($template, $lineno, $types, $sizes, @det_data) = @_;
    my ($event_type, $data);
    my ($exec_str, $detail_data_str);
    local ($types_first, $types_rest, $sizes_first, $sizes_rest);
    local ($rc, $i);

    # Use the last 2 characters of the template ID to find the event type.
    $event_type = $FFDC_EVENT_TYPE{substr($template, -2)};
    $detail_data_str = "";
    if ($types) {
        $types_rest = $types;
        $sizes_rest = $sizes;
        $i = 0;
        while ($types_rest) {
            ($types_first, $types_rest) = split(',', $types_rest);
            ($sizes_first, $sizes_rest) = split(',', $sizes_rest);
            # Truncate a string if its length exceeds the reserved space.
            if (($types_first eq "ALPHA") &&
                (length($det_data[$i]) > $sizes_first)) {
                $det_data[$i] = substr($det_data[$i], 0, $sizes_first);
            }
            $det_data[$i] =~ s/,/./g;

            # remove quotes to avoid confusing the fclogerr string
            # (cannot use de_quote() because this only remove the quotes
            # at the beginning and end of string)
            $det_data[$i] =~ s/\"//g;

            $i++;
        }
        $data = join(',', @det_data);

        # remove \n
        chomp($data);

        $detail_data_str = "-x $types -y $sizes -d \"$data\" -b \"$data\"";
    }
    $exec_str = "$FFDC_FCLOGERR " . $detail_data_str . 
                " -p $lineno -s $0 -v $SCCSID_VERSION -l $LPP_NAME -r $SUBSYS" .
                " -t $template -e $event_type -i $FFDC_TEMPLATE_INCLUDE_FILE";
    run_command("", "$exec_str", $rc);
    if ($HATS_DBG{"ffdc_errlog"}) {
        print STDERR "ffdc_errlog(): $exec_str\n";
        print STDERR "ffdc_errlog(): Return code: $rc\n";
    }
    return ($rc);
}

#=======================================================================#
#                                                                       #
# Function: get_emsg_body                                               #
# Description: Get the message body of an error message.                #
#     An error message contains the subsystem name, 4-digit component   #
#     number, 3-digit message number, and the message body. This        #
#     function returns the message body of an error message by          #
#     stripping the leading subsystem name, component number and        #
#     message number.                                                   #
#                                                                       #
# Input:                                                                #
#     locale: the locale to use when getting the error message          #
#     message_label: the label of the error message in EMSGnnn form.    #
#     argument: variable number of arguments for the error message.     #
#                                                                       #
# Return:                                                               #
#     the message body of the error message.                            #
#                                                                       #
#=======================================================================#

sub get_emsg_body {
    local ($locale, $message_label, @argument) = @_;
    local ($emsg_id, $errmsg);

    $errmsg = get_cat_msg(@_);
    $emsg_id = $message_label;
    $emsg_id =~ s/EMSG//;       # Get error message number by stripping "EMSG"
    # Remove the leading subsystem name, component number and message number.
    # "2523" is the component number of the Topology Services subsystem.
    $errmsg =~ s/^.*2523-$emsg_id *//;
    if ($HATS_DBG{"get_emsg_body"}) {
        print STDERR "get_emsg_body(): $errmsg";
    }
    return($errmsg);
}

#########################################################################
#                                                                       #
# Log related                                                           #
#                                                                       #
#########################################################################

#=======================================================================#
#                                                                       #
# Function: script_log_management                                       #
# Description: save extra info in the script log, remove                #
#     temporary files created by this script, and save a number of      #
#     instances of the script log files.                                #
#                                                                       #
#     This should be called at the very end of the execution            #
# Note: run_command() may call fatal_error() and indirectly call back   #
#     to script_log_management() from inside of fatal_error(). Use only #
#     0 or 1 for the 4'th parameter ($on_error) when calling            #
#     run_command() to avoid infinite recursion.                        #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub script_log_management {
    local ($filename);
    local (@file_contents);
    local ($src_no, $dst_no);
    local ($rc);

    if ($daemon_exec_opt) {
        # print contents of files that are marked for 'saving'
        foreach $filename (@files_to_save_in_log) {
            #print STDERR "===== File name: $filename =====\n";
            print_message("I_CthatsFilename", "$filename");
            if ((-e $filename) && (-r $filename) && (-s $filename)) {
                @file_contents = run_command("", "cat $filename", $rc, 1, 1);
                # The following message is the contents of the file.
                # Print it out directly.
                print STDERR @file_contents;
            }
        }
    
        # remove temporary files
        foreach $filename (@files_to_remove_when_die) {
            if (-e $filename) {
                #print STDERR "----- Removing temporary file: %1$s -----\n";
                print_message("I_CthatsRemoveTemp", "$filename");
                unlink $filename;
            }
        }
        # The following message is produced by date command in the current
        # locale. Print it out directly.
        print STDERR run_command("", "date", $rc, 1, 1);
    
        # if this function is called by fatal_error() too early in the script
        # execution then scriptLogFile might not even be defined
        if (defined($scriptLogFile)) {
            if ((-f $scriptLogFile) && (-s $scriptLogFile)) {
                # save $scriptLogFile.<N> to $scriptLogFile.<N+1>
                $src_no = $NUM_SCRIPT_LOGS_TO_KEEP - 1;
                while ( $src_no >= 1 ) {
                    $dst_no = $src_no + 1;
                    if (-e "$scriptLogFile.$src_no") {
                        run_command("", "mv -f $scriptLogFile.$src_no " .
                            "$scriptLogFile.$dst_no", $rc, 1, 1);
                    }
                    $src_no--;
                }
            }
            run_command("", "cp -f $scriptLogFile $scriptLogFile.1", $rc, 1, 1);
        }
    }
}

#=======================================================================#
#                                                                       #
# Function: log_core_cleanup                                            #
# Description: clean up the old core and log files.                     #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub log_core_cleanup {
    local ($last_log_time);
    local ($log_timestamp);
    local ($rc);

    # The service log file names are: ${SUBSYS}.dd.hhmmss.${cluster_name},
    # where dd=[01..31], hh=[00-23], mm=[00-59], ss=[00-59].
    $log_timestamp = "[0-3][0-9].[0-2][0-9][0-5][0-9][0-5][0-9]";

    # Rename any core files based on previous log name.
    if ( -e "$HB_RUNDIR/core") {

        # find previous log file name
        $last_log_time = join(' ', run_command("", 
            "ls -tr $HB_LOGDIR/$SUBSYS.$log_timestamp | tail -1", $rc, 1));
        chomp($last_log_time);

        if ( -e $last_log_time ) {
            $last_log_time =~ s/$HB_LOGDIR\/$SUBSYS.//;
            if ($HATS_DBG{"log_core_cleanup"}) {
                print STDERR "log_core_cleanup(): Executing: " .
                    "mv $HB_RUNDIR/core $HB_RUNDIR/core.$last_log_time\n";
            }
            run_command("", "mv -f $HB_RUNDIR/core $HB_RUNDIR/core.$last_log_time");
        } else {
            run_command("", "mv -f $HB_RUNDIR/core $HB_RUNDIR/core.unknown");
        }
    }
    # Remove the oldest corefile > $NUM_CORES_TO_KEEP and make the total
    # disk space used by core.* less than $MAX_CORE_SIZE.
    # There is one exception: we keep at least one core.* file even if
    # its size exceeds $MAX_CORE_SIZE. Hence, the remove logic is activated
    # only when there are two or more core.* files.
    clean_old_files("$HB_RUNDIR/core.*", "core.*", $NUM_CORES_TO_KEEP,
        $MAX_OLD_CORE_SIZE);

    # Remove the oldest logs
    clean_old_files("$HB_LOGDIR/$SUBSYS.$log_timestamp*",
        "$SUBSYS.$log_timestamp", $NUM_DAEMON_LOGS_TO_KEEP, $MAX_OLD_LOG_SIZE);
}

#=======================================================================#
#                                                                       #
# Function: clean_old_files                                             #
# Description: remove old files with the given pattern based on the     #
#     numbers and total sizes of files.                                 #
#     The algorithm first assumes all files need to be removed and then #
#     gets rid of the files we want to keep from the removing list.     #
#                                                                       #
# Input:                                                                #
#    pattern_all: the pattern of the file names we are dealing with     #
#    pattern_keep: the pattern of the files we want to save             #
#    num_to_keep: maximum number of the instances to be kept            #
#    max_size: maximum total size of the files to be kept               #
#                                                                       #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub clean_old_files {
    local ($pattern_all, $pattern_keep, $num_to_keep, $max_size) = @_;
    local (@files_to_remove, @files_to_keep, @associated_files, @actual_delete);
    local ($i, $f, $rc);

    if ($HATS_DBG{"clean_old_files"}) {
        print STDERR "clean_old_files(): pattern_all=$pattern_all, " .
            "pattern_keep=$pattern_keep, num_to_keep=$num_to_keep, " .
            "max_size=$max_size\n";
    }
    # Find all files that match the given all file pattern and sort them 
    # by time (new files come first). The output is a list of file
    # sizes and names.
    @files_to_remove = run_command("", "ls -ts $pattern_all", $rc, 1);
    chomp(@files_to_remove);
    @files_to_keep = grep(/.*\/${pattern_keep}$/, @files_to_remove);
    chomp(@files_to_keep);
    if ($HATS_DBG{"clean_old_files"} >= 2) {
        print STDERR "clean_old_files(): originally all files:\n";
        foreach $i (@files_to_remove) {
            print STDERR "    $i\n";
        }
        print STDERR "clean_old_files(): originally files to keep:\n";
        foreach $i (@files_to_keep) {
            print STDERR "    $i\n";
        }
    }
    if (($num_to_keep >= 0) && ($num_to_keep <= $#files_to_keep)) {
        @files_to_keep =
            ($num_to_keep > 0) ? @files_to_keep[0..$num_to_keep - 1] : ();
    }
    if ($HATS_DBG{"clean_old_files"} >= 2) {
        print STDERR "clean_old_files(): after counting num_to_keep:\n";
        foreach $i (@files_to_keep) {
            print STDERR "    $i\n";
        }
    }
    if ($max_size >= 0) {
        # Count the total size of the files to keep and their associated
        # files. e.g. hats.28.091001.IW.bak, hats.28.091001.IW.en_US are
        # associated files of hats.28.091001.IW. We keep all associated
        # files if we keep the base file and remove all associated files
        # if we remove the base file.
        $total_size = 0;
        for ($i = 0; ($i <= $#files_to_keep) && ($total_size <= $max_size);
            $i++) {
            # Output of "ls -s" has a leading file size in front of each
            # file name. The following line gets the file name by removing
            # the file size and spaces.
            $files_to_keep[$i] =~ s/ *[0-9]+ //;
            @associated_files = grep(/ $files_to_keep[$i].*/, @files_to_remove);
            # Get total size of all associated files.
            foreach my $f (@associated_files) {
                # Output of "ls -s" has 0 or more leading spaces followed
                # by the file size followed by a space followed by the file 
                # name. The following line extracts the second field,
                # the file size.
                $f =~ s/(^ *)([0-9]+)( $files_to_keep[$i])/$2/;
                $total_size += $f;
            }
        }
        if ($total_size > $max_size) {
            @files_to_keep = ($i > 0) ? @files_to_keep[0..$i - 1] : ();
        }
    }
    if ($HATS_DBG{"clean_old_files"} >= 2) {
        print STDERR "clean_old_files(): after counting max_size:\n";
        foreach $i (@files_to_keep) {
            print STDERR "    $i\n";
        }
    }
    foreach $f (@files_to_keep) {
        @files_to_remove = grep(!/$f/, @files_to_remove);
    }
    @actual_delete = ();
    foreach $f (@files_to_remove) {
        # Get the file name by removing the leading file size and spaces.
        $f =~ s/ *[0-9]+ //;
        # Perl unlink can remove directories. We want to remove files only.
        if (-f $f) {
            if ($HATS_DBG{"clean_old_files"}) {
                print STDERR "clean_old_files(): removing $f\n";
            }
            push(@actual_delete, $f);
        }
    }
    if ($#actual_delete >= 0) {
        unlink @actual_delete;
    }
}
        
#########################################################################
#                                                                       #
# Commonly used utilities                                               #
#                                                                       #
#########################################################################

#=======================================================================#
#                                                                       #
# Function: run_command                                                 #
# Description: Run a series of commands that concatenated by "|" and    #
#     send back the output of the last command if all the commands      #
#     exist and are executable.                                         #
#                                                                       #
# Developers' note:                                                     #
#       It is handy to use "`LC_ALL=en_US $command`" to get the command #
#       to produce output in English. Unfortunately, it appears that    #
#       the command $command is executed, but the output is not sent    #
#       back to the caller. Hence we need to save/change/restore        #
#       environment variable LC_ALL to get the output string from       #
#       $command.                                                       #
# Developers' note: "`VAR=val command`" works incorrectly if the        #
#       environment name contains '_'. eg. LC_ALL. Otherwise, it works  #
#       correctly. A Perl5 bug?                                         #
#                                                                       #
# Input:                                                                #
#     locale: The locale to be used for messages displayed by the       #
#         command.                                                      #
#     ext_commands: The external commands to run and their parameters   #
#         This parameter is optional. The default value is "".          #
#     redirect_stderr: if we should redirect stderr to /dev/null.       #
#         This parameter is optional. The default value is 0.           #
#         1 : redirect the stderr of the command to /dev/null           #
#         2 : redirect the stderr of the command to its stdout          #
#         0 and others: do not redirect the stderr of the command       #
#     on_error: what to do when the external command does not exist or  #
#         is not executable. This parameter is optional. The default    #
#         value is 2.                                                   #
#         0 : return the error code only.                               #
#         1 : return the error code and print an error message.         #
#         2 and others : print an error message and exit                #
#                                                                       #
# Output:                                                               #
#     exit_code: the exit code of the last command                      #
#         This parameter is optional. No exit code is returned if this  #
#         parameter is missing.                                         #
#         < 0    : the command was interrupted by signal -$exit_code    #
#         0..255 : exit code of the command                             #
#         256    : the command exists but is not executable             #
#         257    : the command does not exist                           #
#                                                                       #
# Return:                                                               #
#     A list holding the output of the last command                     #
#                                                                       #
#=======================================================================#
 
sub run_command {
    # parameters: $locale, $ext_commands, $exit_code, $redirect_stderr, $on_error
    local ($locale, $ext_commands, $exit_code, $redirect_stderr, $on_error);
    local ($lc_all_exist, $lc_all_save);
    local ($to_run_command, $ext_command, $command_name, $rest);
    local ($full_path);
    local (@cmd_output);
    local ($return_exit_code);

    # Shell built-in commands used in this program
    %ksh_builtin_cmd = (
        # POSIX regular commands
        "alias" => 1,   "bg" => 1,      "cd" => 1,      "command" => 1,
        "false" => 1,   "fc" => 1,      "fg" => 1,      "getopts" => 1,
        "jobs" => 1,    "kill" => 1,    "read" => 1,    "true" => 1,
        "umask" => 1,   "unalias" => 1, "wait" => 1,
        # POSIX special commands
        "." => 1,       ":" => 1,       "break" => 1,   "continue" => 1,
        "eval" => 1,    "exec" => 1,    "exit" => 1,    "export" => 1,
        "readonly" => 1, "return" => 1, "set" => 1,     "shift" => 1,
        "trap" => 1,    "unset" => 1,
        # Additional ksh regular commands
        "[" => 1,       "echo" => 1,    "let" => 1,     "print" => 1,
        "pwd" => 1,     "test" => 1,    "ulimit" => 1,  "whence" => 1,
        # Additional ksh special commands
        "builtin" => 1, "times" => 1,   "typeset" => 1
    );

    # Get input parameters.
    $locale = $_[0];
    $ext_commands = ($#_ >= 1) ? $_[1] : "";
    $return_exit_code = ($#_ >= 2) ? 1 : 0;
    $redirect_stderr = ($#_ >= 3) ? $_[3] : 0;
    $on_error = ($#_ >= 4) ? $_[4] : 2;     # 2: print an error message and exit
    if ($HATS_DBG{"run_command"}) {
        print STDERR "run_command(): ext_commands=$ext_commands, " .
            "on_error=$on_error, redirect_stderr=$redirect_stderr\n";
    }
    $redir_stderr = ($redirect_stderr == 2) ? "2>&1" :
        ($redirect_stderr == 1) ? "2> /dev/null" : "";
    $exit_code = 0;
    $to_run_command = "";
    # Users may use pipe to connect several commands. Search $PATH for
    # the full paths of each command.
    ($ext_command, $ext_commands) = split(/\|/, $ext_commands, 2);
    if (! defined($ext_commands)) {
        $ext_commands = "";
        if (! defined($ext_command)) {
            $ext_command = "";
        }
    }
    while ($ext_command && (! $exit_code)) {
        if ($HATS_DBG{"run_command"}) {
            print STDERR "run_command(): current_cmd=$ext_command, " .
                "rest_cmds=$ext_commands\n";
        }
        $ext_command =~ s/^[$SPACE_CHARS]+//;   # Remove possible leading spaces
        ($command_name, $rest) = split(/[$SPACE_CHARS]+/, $ext_command, 2);
        if (! defined($rest)) {
            $rest = "";
        }
        if (exists($ksh_builtin_cmd{$command_name})) {
            # There will be an extra "|" at the end of $to_run_command.
            # We will chop it before running $to_run_command. 
            $to_run_command .= "$command_name $rest $redir_stderr|";
        } else {
            $full_path = path_search($command_name);
            if ($full_path) {
                if (-x $full_path) {
                    # There will be an extra "|" at the end of $to_run_command.
                    # We will chop it before running $to_run_command. 
                    $to_run_command .= "$full_path $rest $redir_stderr|";
                } else {
                    $exit_code = 257;
                    if ($on_error) {
                        if ($on_error == 1) {
                            #print STDERR "$full_path is not executable\n";
                            print_message("EMSG869", "$SCRIPT", "$full_path");
                        } else {
                            ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__,
                                "ALPHA", "100", $full_path);
                            #"$full_path is not executable";
                            fatal_error(1, "EMSG869", "$SCRIPT", "$full_path");
                        }
                    }
                }
            } else {
                $exit_code = 256;
                if ($on_error) {
                    if ($on_error == 1) {
                        #print STDERR "Cannot find command $command_name in " .
                        #    "paths $ENV{\"PATH\"}\n";
                        print_message("EMSG870", "$SCRIPT", "$command_name",
                            "$ENV{\"PATH\"}");
                    } else {
                        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__,
                            "ALPHA", "100", $command_name);
                        #"Cannot find command $command_name in paths
                        #$ENV{\"PATH\"}"
                        fatal_error(1, "EMSG870", "$SCRIPT",
                            "$command_name", "$ENV{\"PATH\"}");
                    }
                }
            }
        }
        ($ext_command, $ext_commands) = split(/\|/, $ext_commands, 2);
        if (! defined($ext_commands)) {
            $ext_commands = "";
            if (! defined($ext_command)) {
                $ext_command = "";
            }
        }
    }
    if ($to_run_command && !$exit_code) {
        # remove the last "|".
        chop($to_run_command);
        if ($HATS_DBG{"run_command"}) {
            print STDERR "run_command(): to_run_command=$to_run_command\n";
        }
        # Temporarily change locale to execute the commands.
        if ($locale) {
            # Save LC_ALL
            if (exists($ENV{LC_ALL})) {
                $lc_all_exist = 1;
                $lc_all_save = $ENV{LC_ALL};
            } else {
                $lc_all_exist = 0;
            }
            $ENV{LC_ALL}=$locale;
        }
        @cmd_output = `$to_run_command`;
        $exit_code = get_exit_code($?);
        if ($locale) {
            # Restore LC_ALL
            if ($lc_all_exist) {
                $ENV{LC_ALL} = $lc_all_save;
            } else {
                delete($ENV{LC_ALL});
            }
        }
    } else {
        @cmd_output = ();
    }
    if ($return_exit_code) {
        $_[2] = $exit_code;     # Use alias to pass back exit code to the caller
    }
    return (@cmd_output);
}

#=======================================================================#
#                                                                       #
# Function: path_search                                                 #
# Description: search the given file in the specified paths.            #
#                                                                       #
# Input:                                                                #
#     file: file name to be searched.                                   #
#     path: optional. If given, the paths to be searched. The paths are #
#           ":" separated. Environment variable PATH is used if this    #
#           parameter is not given.                                     #
#                                                                       #
# Return:                                                               #
#     path/file: if success                                             #
#     ""       : if not success                                         #
#                                                                       #
#=======================================================================#

sub path_search {
    local ($file, $path) = @_;
    local ($searchpath);
    local ($path_not_found);

    $path_not_found = 1;
    if (! $path) {
        $path = $ENV{"PATH"};
    }
    $file =~ s/^[$SPACE_CHARS]+//;   # Remove possible leading spaces
    if ($file) {
        if (index($file, "/") >= 0) {
            # The given file name contains "/". It is already in an absolute
            # or relative path format. We don't check it against the path
            # given in the second parameter.
            if (-e $file) {
                $path_not_found = 0;
                $searchpath = $file;
            }
        } else {
            while ($path && $path_not_found) {
                # Find the ":" separator. If there are ":" in $path, there are
                # more than one path to parse and the first path is from the
                # first character of $path to the character before the first :.
                # Otherwise, $path contains only one path.
                $pos = index($path, ":");
                if ($pos >= 0) {
                    $searchpath = ($pos == 0) ? "" : substr($path, 0, $pos);
                    $path = substr($path, $pos + 1);
                } else {
                    $searchpath = $path;
                    $path = "";
                }
                # This check is needed for empty paths. e.g ":::/bin:/usr/bin:".
                if ($searchpath) {
                    # Remove trailing "/" if the search path has one.
                    # This also takes care of the case that $searchpath eq "/".
                    $searchpath =~ s/\/$//;
                    $searchpath = $searchpath . "/" . $file;
                    if (-e $searchpath) {
                        $path_not_found = 0;
                    }
                }
            }
        }
    }
    return (($path_not_found) ? "" : $searchpath);
}

#=======================================================================#
#                                                                       #
# Function: fatal_error                                                 #
# Description: print error message in error log, back up the script log #
#     file and exit with the given exit code.                           #
#                                                                       #
# Input:                                                                #
#     exit_code: exit code                                              #
#     err_msg: a list with a message label and variable number of       #
#         arguments for the error message                               #
# Output: None                                                          #
# Return: This subroutine causes the whole program exit. No return.     #
#                                                                       #
#=======================================================================#

sub fatal_error {
    local ($exit_code, @err_msg) = @_;

    print_message(@err_msg);
    script_log_management();

    exit $exit_code;
}

#=======================================================================#
#                                                                       #
# Function: get_exit_code                                               #
# Description: get the exit code of an external command.                #
#     The $? variable in Perl is the status word returned by the wait() #
#     system call. The exit value of the subprocess is actually         #
#     ($? >> 8), and $? & 127 gives which signal, if any, the process   #
#     died from, and $? & 128 reports whether there was a core dump.    #
#     Currently, we return a negative signal number and ignore exit     #
#     code if it is interrupted by a signal. We don't report core dump  #
#     status either.                                                    #
#                                                                       #
# Input:                                                                #
#     exit_code: the exit code to be checked                            #
# Output: None                                                          #
# Return:                                                               #
#     n <  0 : the external command was interrupted by signal -n.       #
#     n >= 0 : the external command exited with exit code n.            #
#                                                                       #
#=======================================================================#

sub get_exit_code {
    local ($exit_code) = @_;
    local ($return_code);

    if ($exit_code & 127) {
        $return_code = ($exit_code & 127) * -1;
    } else {
        $return_code = ($exit_code >> 8);
    }
    if ($HATS_DBG{"get_exit_code"}) {
        print STDERR "get_exit_code(): returns $return_code\n";
    }
    return ($return_code);
}

#=======================================================================#
#                                                                       #
# Function: de_quote                                                    #
# Description: remove quotation marks from both ends of a string if the #
#     same quotation mark appears on both ends. The recognized          #
#     quotation marks are '"' and '''.                                  #
#                                                                       #
# Input:                                                                #
#     in_str: the string to be de-quoted.                               #
# Output:                                                               #
# Return:                                                               #
#     The de-quoted string.                                             #
#                                                                       #
#=======================================================================#

sub de_quote {
    local ($in_str) = @_;
    local ($recognized_quote_marks, $quote_mark);
    local ($out_str);

    $recognized_quote_marks = "'\"";
    $quote_mark = substr($in_str, 0, 1);
    $out_str = $in_str;
    if (length($out_str) >= 2) {
        if (index($recognized_quote_marks, $quote_mark) >= 0) {
            if (substr($in_str, -1, 1) eq $quote_mark) {
                # Remove quotation marks on both ends and "un-escape" the
                # escaped quotation marks in the middle of the string.
                $out_str = substr($in_str, 1, -1);
                $out_str =~ s/\\$quote_mark/$quote_mark/g;
            }
        }
    }
    if ($HATS_DBG{"de_quote"}) {
        print STDERR "de_quote(): =>$in_str<=>>$out_str<=\n";
    }
    return ($out_str);
}

#########################################################################
#                                                                       #
# machines.lst generator                                                #
#                                                                       #
#########################################################################

#########################################################################
#                                                                       #
# Topology Servervices machines.lst generator                           #
#                                                                       #
# Function: hats_mach_lst_gen                                           #
# Description: This function expects an opened input file containing    #
#     the required HATS global and topology specific parameters in      #
#     a standard format and an opened output file that will be used     #
#     to store the generated machines.lst file.                         #
#     This subroutine is written in a fashion that it is independent    #
#     from the rest of cthats.pl so that it acts like a filter. The     #
#     cluster management program can use it like:                       #
#         config-gen | hats_mach_lst_gen | repository-write             #
#                                                                       #
#     To make this module a separate program simply put this module in  #
#     a separate file and add a caller to process command line options. #
#                                                                       #
# Input: None                                                           #
# Return: None                                                          #
#                                                                       #
#=======================================================================#
# Input file format:                                                    #
#                                                                       #
# REALM         "PSSP", "HACMP" or "CLUSTER" required                   #
# PORT          <HATS port number> required                             #
# LOGFILELEN    <Maximum HATS Log file length> optional, default=5000   #
# PIN           optional. Possible values are one of the following 3:   #
#                   1) space-deliminated combination of "TEXT", "DATA", #
#                      and "STACK"                                      #
#                   2) "PROC", which equals "TEXT DATA STACK"           #
#                   3) "NONE"                                           #
#               default is "PROC".                                      #
# FIXED_PRI     <real-time priority value> optional, default=38 for AIX #
#               30 for Linux.                                           #
# CONFIG_INST   <override instance number> Used in scaffold environment #
#               only. Other environments should not have this keywork.  #
#                                                                       #
# for each network {                                                    #
#     NETWORK_NAME  <user defined network name>                         #
#         required to be the first line of each network                 #
#     NETWORK_TYPE  <network type>                                      #
#         required                                                      #
#     NETWORK_FREQ  <frequency>                                         #
#         Time between heartbeats in sec. optional, default=1.          #
#     NETWORK_SENS  <sensitivity>                                       #
#         Number of missing heartbeats allowed before considering a     #
#         communication problem. optional, default=4.                   #
#     NETWORK_NIM_EXEC      <NIM path>                                  #
#         NIM path. Default="$RSCT_BIN"                                 #
#     NETWORK_NIM_PAR       <NIM parameters>                            #
#     NETWORK_SRC_ROUTING   <0/1>                                       #
#         The network has source routing enabled. optional, default=0.  #
#     NETWORK_BCAST <0/1>                                               #
#         The network has broadcast ability. optional, default=0.       #
#     for each adapter in the above network {                           #
#         ADAPTER <IP address/non-IP adapter device name> <adapter type>#
#                 <node> <network_name>                                 #
#     } end adapter                                                     #
# } end network                                                         #
#                                                                       #
#########################################################################

sub hats_mach_lst_gen {
    local ($rc);
    local (@hats_info_file, @topology_info_file);

    # Check parameters for -i and -I option
    if (exists($opts{i}) && $opts{i}) {
        if (open(FP, "< $opts{i}")) {
            @hats_info_file = <FP>; 
            close(FP); 
            push(@files_to_save_in_log, $opts{i});
        } else {
            ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
                $opts{i});
            if (-e $opts{i}) {
                #"File $opts{i} is not readable"
                fatal_error(1, "EMSG867", "$SCRIPT", "$opts{i}");
            } else {
                #"File $opts{i} does not exist"
                fatal_error(1, "EMSG866", "$SCRIPT", "$opts{i}");
            }
        }
    } else {
        if (! exists($opts{I}) || ! $opts{I}) {
            $opts{I} = $DFLT_HATS_INFO;
        }
        @hats_info_file = run_command("", "$opts{I}", $rc);
        if ($rc) {
            ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                "ALPHA,DEC", "96,4", $opts{I}, $rc);
            #"$opts{I} command exits with exit code=$rc"
            fatal_error(1, "EMSG871", "$SCRIPT", "$opts{I}", "$rc");
        }
    }
    if ($HATS_DBG{"hats_mach_lst_gen"}) {
        print STDERR "hats_mach_lst_gen(): parse -i/-I option, -i=",
            (exists($opts{i})) ? $opts{i} : "UNDEFINED",
            ", -I=", (exists($opts{I})) ? $opts{I} : "UNDEFINED", "\n";
    }
    # Check parameters for -t and -T option
    if (exists($opts{t}) && $opts{t}) {
        if (open(FP, "< $opts{t}")) {
            @topology_info_file = <FP>; 
            close(FP); 
            push(@files_to_save_in_log, $opts{t});
        } else {
            ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
                $opts{t});
            if (-e $opts{t}) {
                #"File $opts{t} is not readable"
                fatal_error(1, "EMSG867", "$SCRIPT", "$opts{t}");
            } else {
                #"File $opts{t} does not exist"
                fatal_error(1, "EMSG866", "$SCRIPT", "$opts{t}");
            }
        }
    } else {
        if (! exists($opts{T}) || ! $opts{T}) {
            $opts{T} = $DFLT_TOPOLOGY_INFO;
        }
        @topology_info_file = run_command("", "$opts{T}", $rc);
        if ($rc) {
            ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                "ALPHA,DEC", "96,4", $opts{T}, $rc);
            #"$opts{T} command exits with exit code=$rc"
            fatal_error(1, "EMSG871", "$SCRIPT", "$opts{T}", "$rc");
        }
    }
    if ($HATS_DBG{"hats_mach_lst_gen"}) {
        print STDERR "hats_mach_lst_gen(): parse -t/-T option, -t=",
            (exists($opts{t})) ? $opts{t} : "UNDEFINED",
            ", -T=", (exists($opts{T})) ? $opts{T} : "UNDEFINED", "\n";
    }

    @hats_info_file = (@hats_info_file, @topology_info_file);
    chomp(@hats_info_file);         # Remove trailing '\n'
    parse_hats_info(@hats_info_file);

    build_non_ip_ring();            # Not support yet
    
    network_validation(); 

    $conf_sec = get_security_status();          # Feature 77300
    if ($conf_sec eq "error") {
        ffdc_errlog("ERRID_TS_KEYFILE_ER", __LINE__, "ALPHA", "100",
            $ENV{HB_CTKF_PATH});
        #"Keyfile $ENV{\"HB_CTKF_PATH\"} present but corrupt."
        fatal_error(1, "EMSG667", "$SCRIPT", "$ENV{\"HB_CTKF_PATH\"}");
    }

    if ($HB_MACHINES_LIST) {
        if (! open(OFP, ">$HB_MACHINES_LIST")) {
            ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__,
                "ALPHA", "100", "$HB_MACHINES_LIST");
            #"Error occurred while creating the machine list file"
            fatal_error(1, "EMSG662", "$SCRIPT");
        }
    } else {
        *OFP = *STDOUT;
    }

    output_mach_lst(OFP);

    if ($HB_MACHINES_LIST) {
        close(OFP);
        push(@files_to_save_in_log, $HB_MACHINES_LIST);
    }
}


#=======================================================================#
#                                                                       #
# Function: get_security_status                                         #
# Description: Checks for the existence of the cluster shared secret key#
#              file, If the file is not present, security is off.       #
#              If it is present and seems intact, security is on.       #
#                                                                       #
# Input:  None                                                          #
# Output: None                                                          #
# Return:                                                               #
#         "on" if security is supposed to be on                         #
#         "off" if security is supposed to be off                       #
#         "error" if security is supposed to be on but the key file is  #
#         somehow corrupted (which isn't checked as it stands)          #
#                                                                       #
#=======================================================================#

sub get_security_status() {
    my $rc;

    if ( -r "$ENV{\"HB_CTKF_PATH\"}") {
        return "on";
    }
    return "off";
}


#=======================================================================#
#                                                                       #
# Function: parse_hats_info                                             #
# Description: parse the HATS global and topology infomation            #
#     Variable names of all variables used to store HATS configuration  #
#     information start with conf_.                                     #
#                                                                       #
# Input:                                                                #
#     hats_info_file: a list that contains the HATS global and topology #
#         information. The trailing '\n' has been chopped.              #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub parse_hats_info {
    local @hats_info_file = @_;
    local ($curr_line, $junk);
    my ($curr_network);

    # Supported non-IP adapters.
    # This hash array maps the non-IP device names to the non-IP network 
    # types known to HATS.
    # This "known network type" idea may totally disappear when the
    # pluggable NIM is available.
    %non_ip_net_type = (
        "tty"   => "rs232",
        "tmscsi"=> "tmscsi",
        "tmssa" => "tmssa",
        "diskhb"=> "diskhb"
    );

    $conf_realm = "";
    $conf_environment = "";
    $conf_logfilelen = -1;
    $conf_pin = "";
    $conf_fixed_pri = -1;
    $conf_config_inst = 0;      # Instance number is an unsigned integer.
    @conf_network_name = ();
    $conf_sec = "off";          # Security status

    $curr_network = "";         # parsing global section
    foreach $curr_line (@hats_info_file) {
        if (exists($opts{v}) && $opts{v}) {
            # The following message is the contents of hats_info_file.
            # Print it directly.
            print STDERR "#", $curr_line, "\n";
        }
        # 2 simple s/// are faster than one complex s///.
        $curr_line =~ s/^[$SPACE_CHARS]*//; # Remove possible leading spaces
        $curr_line =~ s/#.*$//;             # Remove possible trailing comments
        ($keyword, $keyvalue) = split(/[$SPACE_CHARS]+/, $curr_line, 2);
        if (! defined($keyvalue)) {
            $keyvalue = "";
            if (! defined($keyword)) {
                $keyword = "";
            }
        }
        # All keywords must have at least one key value.
        # The only exceptions are NETWORK_NIM_EXEC and NETWORK_NIM_PAR.
        if (($keyword ne "NETWORK_NIM_EXEC") &&
            ($keyword ne "NETWORK_NIM_PAR") && ($keyvalue eq "")) {
            ffdc_errlog("ERRID_TS_CONFIG_SYNTAX_ER", __LINE__,
                "ALPHA", "100",
                get_emsg_body("", "EMSG857", "$SCRIPT", "$keyword"));
            #"The key value of key word $keyword is missing"
            fatal_error(2, "EMSG857", "$SCRIPT", "$keyword");
        }
        # Keywords can appear in any order except for network keywords.
        # Network keywords must appear between the NETWORK_NAME keyword
        # defining the network name and the NETWORK_NAME keyword defining
        # the next network name or end of file.
        SWITCH_KEYWORD: {
            # Blank line (after comments removed)
            if (!$keyword) {
                last SWITCH_KEYWORD;
            }
            # Global keywords
            if ($keyword eq "REALM") {
                parse_keyw_val("REALM", $keyvalue, $conf_realm, 0);
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "ENVIRONMENT") {
                parse_keyw_val("ENVIRONMENT", $keyvalue, $conf_environment, 0);
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "PORT") {
                # HATS port is not used in machines.lst generator
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "LOGFILELEN") {
                parse_keyw_val("LOGL", $keyvalue, $conf_logfilelen, 1);
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "PIN") {
                parse_keyw_val("MEMP", $keyvalue, $conf_pin, 0);
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "FIXED_PRI") {
                parse_keyw_val("PRIO", $keyvalue, $conf_fixed_pri, 1);
                # Defect 97577
                if ($conf_fixed_pri == 0) {
                    # priority '0' here means: do not use fixed priority
                    $conf_fixed_pri = -1;
                }

                last SWITCH_KEYWORD;
            }
            if ($keyword eq "CONFIG_INST") {
                parse_keyw_val("", $keyvalue, $conf_config_inst, 1);
                last SWITCH_KEYWORD;
            }
            # Network keywords
            if ($keyword eq "NETWORK_NAME") {
                $curr_network = $keyvalue;
                if (exists($conf_network_type{$curr_network})) {
                    ffdc_errlog("ERRID_TS_CONFIG_SYNTAX_ER", __LINE__,
                        "ALPHA", "100",
                        get_emsg_body("", "EMSG696", "$SCRIPT",
                            "$curr_network"));
                    #Network $curr_network redefined.
                    fatal_error(2, "EMSG696", "$SCRIPT", "$curr_network");
                } else {
                    push(@conf_network_name, $curr_network);
                    $conf_network_type{$curr_network} = "";
                    $conf_network_freq{$curr_network} = -1;
                    $conf_network_sens{$curr_network} = -1;
                    $conf_network_nim_exec{$curr_network} = "";
                    $conf_network_nimpar{$curr_network} = "";
                    $conf_network_src_routing{$curr_network} = -1;
                    $conf_network_bcast{$curr_network} = -1;
                }
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "NETWORK_TYPE") {
                if (net_name_has_set($curr_network)) {
                    parse_keyw_val("", $keyvalue,
                        $conf_network_type{$curr_network}, 0);
                }
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "NETWORK_FREQ") {
                if (net_name_has_set($curr_network)) {
                    parse_keyw_val("NETWORK_FREQ", $keyvalue,
                        $conf_network_freq{$curr_network}, 1);
                }
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "NETWORK_SENS") {
                if (net_name_has_set($curr_network)) {
                    parse_keyw_val("NETWORK_SENS", $keyvalue,
                        $conf_network_sens{$curr_network}, 1);
                }
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "NETWORK_NIM_EXEC") {
                if (net_name_has_set($curr_network)) {
                    parse_keyw_val("NETWORK_NIM_EXEC", $keyvalue,
                        $conf_network_nim_exec{$curr_network}, 0);
                }
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "NETWORK_NIM_PAR") {
                if (net_name_has_set($curr_network)) {
                    parse_keyw_val("NETWORK_NIM_PAR", $keyvalue,
                        $conf_network_nimpar{$curr_network}, 0);
                }
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "NETWORK_SRC_ROUTING") {
                if (net_name_has_set($curr_network)) {
                    parse_keyw_val("NETWORK_SRC_ROUTING", $keyvalue,
                        $conf_network_src_routing{$curr_network}, 1);
                }
                last SWITCH_KEYWORD;
            }
            if ($keyword eq "NETWORK_BCAST") {
                if (net_name_has_set($curr_network)) {
                    parse_keyw_val("NETWORK_BCAST", $keyvalue,
                        $conf_network_bcast{$curr_network}, 1);
                }
                last SWITCH_KEYWORD;
            }
            # Adapter keyword
            if ($keyword eq "ADAPTER") {
                parse_adapter_kw($keyvalue);
                last SWITCH_KEYWORD;
            }
        }       # end of SWITCH_KEYWORD
    }           # end while
}

#=======================================================================#
#                                                                       #
# Function: parse_keyw_val                                              #
# Description: parse a keyword/value line                               #
#                                                                       #
# Input:                                                                #
#     keyword:                                                          #
#         "": do not check if the given value is valid for any keyword. #
#             just check if it is a valid number or string.             #
#         non-"": the keyword the value should be checked with.         #
#     keyvalue: the value to be checked.                                #
#     conf_var: the internal configuration variables to accept the value#
#     is_num:                                                           #
#         0 : the value to be checked is a string                       #
#         1 : the value to be checked is a number                       #
#                                                                       #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub parse_keyw_val {
    local ($keyword, $keyvalue, $conf_var, $is_num) = @_;

    if ($HATS_DBG{"parse_keyw_val"}) {
        print STDERR "parse_keyw_val(): keyword=$keyword, " .
            "keyvalue=$keyvalue, conf_var=$conf_var, is_num=$is_num\n";
    }
    # Remove quotation marks at both ends of a string.
    if ($is_num == 0) {
        $keyvalue = de_quote($keyvalue);
    }
    if ($keyword) {
        if ((($is_num != 0) && ($keyvalue != $DFLT_NUMERIC_VALUE)) ||
            (($is_num == 0) && ($keyvalue ne $DFLT_STRING_VALUE) &&
            ($keyvalue ne ""))) {
            if (hats_chk_values($keyword, $keyvalue) == 0) {
                if (($is_num && ($conf_var == -1)) ||
                    (! $is_num && ($conf_var eq ""))) {
                    $_[2] = ($is_num) ? $keyvalue : "$keyvalue";
                    if ($HATS_DBG{"parse_keyw_val"}) {
                        print STDERR "Assigning checked $keyword = $keyvalue\n";
                    }
                } else {
                    ffdc_errlog("ERRID_TS_CONFIG_SYNTAX_ER", __LINE__,
                        "ALPHA", "100",
                        get_emsg_body("", "EMSG859", "$SCRIPT", "$keyword"));
                    #"Key word \"$keyword\" redefined"
                    fatal_error(2, "EMSG859", "$SCRIPT", "$keyword");
                }
            } else {
                # Use "\"$keyvalue\"" because $keyvalue may
                # contain multiple words.
                ffdc_errlog("ERRID_TS_CONFIG_SYNTAX_ER", __LINE__,
                    "ALPHA", "100",
                    get_emsg_body("", "EMSG858", "$SCRIPT", "\"$keyvalue\"",
                        "$keyword"));
                #"\"$keyvalue\" is not a valid value for variable $keyword"
                fatal_error(2, "EMSG858", "$SCRIPT", "\"$keyvalue\"",
                    "$keyword");
            }
        } else {
            if (hats_def_values($keyword, $keyvalue) >= 0) {
                $_[2] = $keyvalue;
                if ($HATS_DBG{"parse_keyw_val"}) {
                    print STDERR "Assigning default $keyword = $keyvalue\n";
                }
            } else {
                ffdc_errlog("ERRID_TS_CONFIG_SYNTAX_ER", __LINE__,
                    "ALPHA", "100",
                    get_emsg_body("", "EMSG860", "$SCRIPT", "$keyword"));
                #"Unknown key word $keyword"
                fatal_error(2, "EMSG860", "$SCRIPT", "$keyword");
            }
        }
    } else {
        if ($is_num) {
            # Check if the value contains nothing but digits.
            if ($keyvalue =~ m/^-{0,1}[0-9]+$/) {
                $_[2] = $keyvalue;
            } else {
                # Use "\"$keyvalue\"" because $keyvalue may
                # contain multiple words.
                ffdc_errlog("ERRID_TS_CONFIG_SYNTAX_ER", __LINE__,
                    "ALPHA", "100",
                    get_emsg_body("", "EMSG856", "$SCRIPT", "\"$keyvalue\""));
                #"Numeric value \"$keyvalue\" contains non-numeric characters"
                fatal_error(2, "EMSG856", "$SCRIPT", "\"$keyvalue\"");
            }
        } else {
            $_[2] = $keyvalue;
        }
    }
}

#=======================================================================#
#                                                                       #
# Function: parse_adapter_kw                                            #
# Description: parse an ADAPTER keyword line                            #
#     The internal configuration variable to hold the ADAPTER is a two  #
#     level hash like the following:                                    #
#                                                                       #
#     %conf_adapters_by_network{network_name} => {node} => adapter      #
#                                                                       #
#     The "adapter" above is a " " separated string containing the node #
#     number, interface name, and IP address/non-IP adapter device name #
#     of the adapter.                                                   #
#                                                                       #
# Input:                                                                #
#     keyvalue: a string holds the value of an ADAPTER line. A valid    #
#         value should contain the following items separated by ",".    #
#         ip_or_dev: a valid IP address for IP adapters or a valid      #
#             device name for non-IP adapters                           #
#         interface: network interface name                             #
#         node: the node number of the node the adapter resides in      #
#         network: the network name the adapter belongs to              #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub parse_adapter_kw {
    local ($keyvalue) = @_;
    local ($ip_or_dev, $interface, $node, $network, $junk);

    if ($HATS_DBG{"parse_adapter_kw"}) {
        print STDERR "parse_adapter_kw(): keyvalue=$keyvalue|\n";
    }
    ($ip_or_dev, $interface, $node, $network, $junk) =
        split(/[$SPACE_CHARS]+/, $keyvalue, 5);
    if (defined($junk) && ($junk ne "")) {
        # Use "\"$junk\"" because $junk may contain multiple words.
        #print STDERR "Extra parameter \"$junk\" for ADAPTER keyword\n";
        print_message("EMSG692", "$SCRIPT", "\"$junk\"", "ADAPTER");
        # Extra parameter is not that bad. Do not exit here.
    }
    if (! defined($ip_or_dev) || ! $ip_or_dev ||
        ! defined($interface) || ! $interface ||
        ! defined($node) || ! $node ||
        ! defined($network) || ! $network) {
        #print STDERR "ADAPTER keyword needs 4 parameters\n";
        #print STDERR "Input ADAPTER line ignored\n";
        print_message("EMSG693", "$SCRIPT", "ADAPTER", "4");
        print_message("I_CthatsLineIgnored", "ADAPTER");
    } else {
        if (valid_ip_or_dev($ip_or_dev) && valid_interface($interface)) {
            # The format of the following join() is exactly the same as the 
            # adpater information lines in machines.lst file.
            ${$conf_adapters_by_network{$network}}{$node} =
                join(' ', ($node, $interface, $ip_or_dev));
            if ($HATS_DBG{"parse_adapter_kw"}) {
                print STDERR "parse_adapter_kw(): put ($node, $interface, " .
                    "$ip_or_dev) into conf_adapters_by_network{$network}{$node}\n";
            }
        } else {
            # Print interface name if it is an IP network, device name if it
            # is a non-IP network.
            if (valid_ip_or_dev($ip_or_dev)) {
                #print STDERR "Invalid IP address or interface name $interface\n";
                print_message("EMSG694", "$SCRIPT", "$interface");
            } else {
                #print STDERR "Invalid IP address or interface name $ip_or_dev\n";
                print_message("EMSG694", "$SCRIPT", "$ip_or_dev");
            }
            #print STDERR "Input ADAPTER line ignored\n";
            print_message("I_CthatsLineIgnored", "ADAPTER");
        }
    }
}

#=======================================================================#
#                                                                       #
# Function: net_name_has_set                                            #
# Description: check if the given network name has been defined.        #
#     $curr_network is "" when parsing the global section and is given  #
#     a network name when the first NETWORK_NAME keyword appears.       #
#                                                                       #
# Input:                                                                #
#     network_name: The network name to be checked.                     #
# Output:                                                               #
# Return:                                                               #
#     0 : $curr_network is not set                                      #
#     1 : $curr_network is set                                          #
#                                                                       #
#=======================================================================#

sub net_name_has_set {
    local ($network_name) = @_;

    if (! $network_name) {
        #print STDERR "NETWORK_NAME must be the first line of a network\n";
        print_message("EMSG695", "$SCRIPT");
        return(0);
    } else {
        return(1);
    }
}

#=======================================================================#
#                                                                       #
# Function: valid_ip_or_dev                                             #
# Description: check if the given string is a valid IP address or       #
#     non-IP device name.                                               #
#                                                                       #
# Input:                                                                #
#     ip_or_dev: string to be checked                                   #
# Output: None                                                          #
# Return:                                                               #
#     0 : invalid                                                       #
#     1 : valid IP address                                              #
#     2 : valid device name                                             #
#                                                                       #
#=======================================================================#

sub valid_ip_or_dev {
    local ($ip_or_dev) = @_;
    local ($nothing, $devprefix, $devname);
    local ($return_code);

    $return_code = 0;
    ($nothing, $devprefix, $devname) = split(/\//, $ip_or_dev);
    if (! defined($devname)) {
        $devname = "";
        if (! defined($devprefix)) {
            $devprefix = "";
        }
    }
    if (($nothing eq "") && ($devprefix eq "dev")) {
        # chop off the trailing decimal digits (device count).
        if ($devname =~ s/[0-9]+$//) {
            if (exists($non_ip_net_type{$devname})) {
                $return_code = 2;
            }
        }
    } else {
        # Check if is a valid IP address: nn.nn.nn.nn
        if ($ip_or_dev =~ m/^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/) {
            # IP based adapter. Any type is allowed. Just return
            # "valid IP address".
            $return_code = 1;
        }
    }
    if ($HATS_DBG{"valid_ip_or_dev"}) {
        print STDERR "valid_ip_or_dev(): ip_or_dev=$ip_or_dev, " .
            "return_code=$return_code\n";
    }
    return($return_code);
}

#=======================================================================#
#                                                                       #
# Function: valid_interface                                             #
# Description: check if the given string is in a valid IP network       #
#     interface format like eth0:3.                                     #
#     71872: interface names like eth0-1:3 are also accepted.           #
#                                                                       #
# Input:                                                                #
#     interface: interface name to be checked                           #
# Output: None                                                          #
# Return:                                                               #
#     0 : given string is not in a valid network interface format       #
#     1 : given string is in a valid network interface format           #
#                                                                       #
#=======================================================================#

sub valid_interface {
    local ($interface) = @_;

    $return_code = 0;
    # Alias network name should look like eth0, eth1:8, eth3-2:5, or
    # ipoib-ud0 (Infiniband)
    ($interface, $alias) = split(/:/, $interface);
    if (! defined($alias)) {
        $alias = "";
        if (! defined($interface)) {
            $interface = "";
        }
    }
    if (($alias eq "") || ($alias =~ m/^[0-9]+$/)) {
        # chop off the trailing decimal digits (device count).
        if (($interface =~ m/^[A-Za-z]+[0-9]+(-[0-9]+)?$/) ||
            ($interface =~ m/^[A-Za-z]+-[A-Za-z]+[0-9]+$/)) {
            # Defect 97451 - Added a second line to include Infiniband 
            # interfaces.  The alternative is to skip this test entirely, which
            # makes this function useless.
            $return_code = 1;
        }
    }
    if ($HATS_DBG{"valid_interface"}) {
        print STDERR "valid_interface(): interface=$interface, " .
            "return_code=$return_code\n";
    }
    return($return_code);
}

#=======================================================================#
#                                                                       #
# Function: build_non_ip_ring                                           #
# Description: build non-IP network heartbeat ring                      #
#     This subroutine has not been implementated yet.                   #
#                                                                       #
#=======================================================================#

sub build_non_ip_ring {
}

#=======================================================================#
#                                                                       #
# Function: network_validation                                          #
# Description: verify if the topology is valid. This subroutine can be  #
#     very complicated if we want to check everything.                  #
#     This subroutine has not been implementated yet.                   #
#                                                                       #
#=======================================================================#

sub network_validation {
}

#=======================================================================#
#                                                                       #
# Function: output_mach_lst                                             #
# Description: output machine list based on the information in conf_xxx #
#     internal configuration variables.                                 #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub output_mach_lst {
    local ($configid);
    # TS_Frequency=, TS_Sensitivity=, 
    # no longer needed in global section because we have
    # the values for each network.
    # HACMP specific keywords are not considered yet
    #     TS_EnableIPAT, TS_MigrateToShiloh, TS_HACMP_version=,
    #     Service Address=, Node of Service Address=
    # PSSP specific keywords are not considered yet
    #     HaTsSeCKeyVersion=, HaTsSeCKeyCount=
    # HaTsSeCStatus IS considered, as it is no longer PSSP-specific
    # Feature 77300

    # InstanceNumber is given only in scaffold environment.
    if ($conf_config_inst == 0) {
        $conf_config_inst = time;
    }
    print OFP "*InstanceNumber=$conf_config_inst\n";

    # Config ID is derived from cluster name instead of cluster ID
    # because cluster IDs are not consistent between nodes in a 
    # cluster unless we are in ConfigRM environment.
    $configid = ($conf_environment eq "cfgmgr") ? $cluster_id : $cluster_name;

    # join() is used because run_command() returns a list, but split
    # expects a single scalar string.
    ($conf_configid, $junk) = split(/[$SPACE_CHARS]+/,
        join (' ', run_command("", "echo $configid | cksum")));
    print OFP "*configId=$conf_configid\n";

    # Print security status
    print OFP "*!HaTsSeCStatus=$conf_sec\n";

    print OFP "*!TS_realm=$conf_realm\n";

    if($conf_environment eq "cfgmgr") {
        print OFP "*!TS_environment=CONFIGRM\n";
    }
    else {
        print OFP "*!TS_environment=SCAFFOLD\n";
    }
 
    # 91966: AIX/Linux Interoperability
    if (($RSCTActiveVersion ne "-1") && ($RSCTActiveVersion =~ /[1-9]/)) {
        print OFP sprintf("*!RSCTActivEVersioN=%d%2.2d%2.2d%2.2d\n",
                          split(/\./, $RSCTActiveVersion));
    }

    if ($conf_fixed_pri != -1) {
        print OFP "TS_FixedPriority=$conf_fixed_pri\n";
    }
    if ($conf_logfilelen != -1) {
        print OFP "TS_LogLength=$conf_logfilelen\n";
    }

    # 110245: in case the keywords are separated by spaces
    $conf_pin =~ s/[$SPACE_CHARS]+/,/g;

    foreach my $i (split(/,/, $conf_pin)) {
        SWITCH_PIN_TOKEN: {
            if ($i eq "TEXT") {
                print OFP "*!TS_PinText\n";
                last SWITCH_PIN_TOKEN;
            }
            if ($i eq "DATA") {
                print OFP "*!TS_PinData\n";
                last SWITCH_PIN_TOKEN;
            }
            if ($i eq "STACK") {
                print OFP "*!TS_PinStack\n";
                last SWITCH_PIN_TOKEN;
            }
            if ($i eq "PROC") {
                if ("$SYS_SYSNAME" eq "Linux") {
                    print OFP "*!TS_PinText\n*!TS_PinData\n*!TS_PinStack\n";
                } elsif ("$SYS_SYSNAME" eq "AIX") {
                    print OFP "*!TS_PinText\n*!TS_PinData\n";
                } else {
                    # We should have exited from inside hats_chk_values_init()
                    # if $SYS_SYSNAME is not supported.
                }
                last SWITCH_PIN_TOKEN;
            }
            if ($i eq "NONE") {
                # Nothing to print for NONE
                last SWITCH_PIN_TOKEN;
            }
        }
    }
    # Output IP networks and keep non-IP networks in $non_ip_nets for 
    # later process
    foreach my $net_name (@conf_network_name) {
        if ($HATS_DBG{"output_mach_lst"}) {
            print STDERR "output_mach_lst(): output network $net_name\n";
        }
        if (! exists($non_ip_net_type{$conf_network_type{$net_name}})) {
            print OFP "Network Name $net_name\n";
            print OFP "Network Type $conf_network_type{$net_name}\n";
            if ($conf_network_freq{$net_name} != -1) {
                print OFP "*!TS_Frequency=$conf_network_freq{$net_name}\n";
            }
            if ($conf_network_sens{$net_name} != -1) {
                print OFP "*!TS_Sensitivity=$conf_network_sens{$net_name}\n";
            }

            # under some conditions we are getting:
            #    NETWORK_NIM_EXEC (null)
            #    NETWORK_NIM_PAR (null)

            if (($conf_network_nim_exec{$net_name} ne "") &&
                !($conf_network_nim_exec{$net_name} =~ /\(null\)/)) {
                print OFP "*!NIM_pathname=$conf_network_nim_exec{$net_name}\n";
            }
            else {
                if(hats_def_values("NETWORK_NIM_EXEC", $default_value) >= 0) {
                    print OFP "*!NIM_pathname=$default_value\n";
                }
            }

            if (($conf_network_nimpar{$net_name} ne "") &&
                !($conf_network_nimpar{$net_name} =~ /\(null\)/)) {
                print OFP "*!NIM_parameters=$conf_network_nimpar{$net_name}\n";
            }
            # Note: set_net_option() will parse machines.lst for
            # "*!NIM_Src_Routing=". Any change in the following statements
            # may affect set_net_option().
            if ($conf_network_src_routing{$net_name} != -1) {
                print OFP "*!NIM_Src_Routing=" .
                    "$conf_network_src_routing{$net_name}\n";
            }
            if ($conf_network_bcast{$net_name} != -1) {
                print OFP "*!NIM_Broadcast=$conf_network_bcast{$net_name}\n";
            }
            foreach my $node (sort {$a <=> $b}
                keys %{$conf_adapters_by_network{$net_name}}) {
                print OFP "    ${$conf_adapters_by_network{$net_name}}{$node}" .
                    "\n";
            }
        } else {
            push(@non_ip_nets, $net_name);
        }
    }
    # output non-IP networks
    foreach my $net_name (@non_ip_nets) {
        print OFP "Network Name $net_name\n";
        print OFP "Network Type $conf_network_type{$net_name}\n";
        if ($conf_network_freq{$net_name} != -1) {
            print OFP "*!TS_Frequency=$conf_network_freq{$net_name}\n";
        }
        if ($conf_network_sens{$net_name} != -1) {
            print OFP "*!TS_Sensitivity=$conf_network_sens{$net_name}\n";
        }
        foreach my $node (sort {$a <=> $b}
            keys %{$conf_adapters_by_network{$net_name}}) {
            print OFP "    ${$conf_adapters_by_network{$net_name}}{$node}\n";
        }
    }
}

#=======================================================================
#
# End of machines.lst generator.
#
#=======================================================================

#=======================================================================#
#                                                                       #
# Function: hats_chk_values_init                                        #
# Description: initialize the keyword/value checking based on the       #
#     operating system and machine architecture.                        #
#                                                                       #
#     Special value $HATS_CHK_VAL_IS_LIST in %hats_lower{variable}      #
#     indicates the valid values of variable are presented as a list,   #
#     separated by ",,", in %hats_upper{variable}.                      #
#     Special value $HATS_CHK_VAL_ANY_VAL in %hats_lower{variable}      #
#     means we cannot determine if the value is valid or not,           #
#                                                                       #
#     Note: Since we use $HATS_CHK_VAL_IS_LIST(-999999999) in hats_lower#
#     to distinguish ranged values listed values, this subroutine needs #
#     to be changed if -999999999 become valid.                         #
#     The same applies to $HATS_CHK_VAL_ANY_VAL($HATS_CHK_VAL_IS_LIST+1)#
# Input: None                                                           #
# Output: None                                                          #
# Return:                                                               #
#     0 : success                                                       #
#     -1: not success (Unsupported OS/architecture)                     #
#                                                                       #
#=======================================================================#

sub hats_chk_values_init {
    local ($return_code);

    # Set valid values for HATS parameters.
    # There are two ways to specify valid vlues: 
    # 1) by the range, i.e. lower bound and higher bound
    # 2) by list
    # Normally, hats_lower and hats_upper specify the lower and upper
    # bounds of valid values. e.g. hats_lower=1 and hats_upper=30 means
    # the valid range is from 1 to 30, inclusive.
    # When the value in hats_lower is negative, the corresponding item
    # in hats_upper is a list of valid values. 
    # The valid value list is a list of valid value groups separated by ',,'.
    # A valid value can be a single value or a ',' separated values in
    # the same value group.
    # e.g. memp can be one of:
    #     A) any combination of Text, Data, and Stack
    #     B) Proc
    #     C) None
    # For example, Stack and Text together is valid while Text and Proc 
    # together is invalid.
    $HATS_CHK_VAL_IS_LIST = -999999999;
    $HATS_CHK_VAL_ANY_VAL = $HATS_CHK_VAL_IS_LIST + 1;
    $return_code = 0;
    if ("$SYS_SYSNAME" eq "Linux") {
        %hats_lower = (
            "REALM"     => $HATS_CHK_VAL_IS_LIST,
            "ENVIRONMENT"       => $HATS_CHK_VAL_IS_LIST,
            "FREQ"      => 1,
            "SENS"      => 4,
            "PRIO"      => 1,
            "LOGL"      => 2000,
            "MEMP"      => $HATS_CHK_VAL_IS_LIST,
            # The "supported IP based network type" is no longer checked
            # because the pluggable NIM supports any IP based network type.
            "NETWORK_TYPE"      => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_FREQ"      => 1,
            "NETWORK_SENS"      => 4,
            "NETWORK_NIM_EXEC"  => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_NIM_PAR"   => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_SRC_ROUTING"       => 0,
            "NETWORK_BCAST"     => 0
        );
        %hats_upper = (
            "REALM"     => "CLUSTER,,Clusters",
            "ENVIRONMENT"       => "scaffold,,gpfs,,cfgmgr",
            "FREQ"      => 30,
            "SENS"      => 40,
            "PRIO"      => 80,
            "LOGL"      => 1000000,
            "MEMP"      => "TEXT,DATA,STACK,,PROC,,NONE",
            "NETWORK_TYPE"      => "ether,,token,,myrinet",
            "NETWORK_FREQ"      => 30,
            "NETWORK_SENS"      => 40,
            "NETWORK_NIM_EXEC"  => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_NIM_PAR"   => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_SRC_ROUTING"       => 1,
            "NETWORK_BCAST"     => 1
        );
        %hats_default = (
            "REALM"     => "",
            "ENVIRONMENT"       => "",
            "FREQ"      => 1,
            "SENS"      => 8,
            "PRIO"      => 30,
            "LOGL"      => 5000,
            "MEMP"      => "PROC",
            "NETWORK_TYPE"      => "",
            "NETWORK_FREQ"      => 1,
            "NETWORK_SENS"      => 8,
            "NETWORK_NIM_EXEC"  => "$RSCT_BIN/hats_nim",
            "NETWORK_NIM_PAR"   => "",
            "NETWORK_SRC_ROUTING"       => 0,
            "NETWORK_BCAST"     => 0
        );
    } elsif ("$SYS_SYSNAME" eq "AIX") {
        # AIX uname returns encoded machine type. Need to figure out how to
        # check it.
        %hats_lower = (
            "REALM"     => $HATS_CHK_VAL_IS_LIST,
            "ENVIRONMENT"       => $HATS_CHK_VAL_IS_LIST,
            "FREQ"      => 1,
            "SENS"      => 4,
            "PRIO"      => 40,
            "LOGL"      => 2000,
            "MEMP"      => $HATS_CHK_VAL_IS_LIST,
            # The "supported IP based network type" is no longer checked
            # because the pluggable NIM supports any IP based network type.
            "NETWORK_TYPE"      => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_FREQ"      => 1,
            "NETWORK_SENS"      => 4,
            "NETWORK_NIM_EXEC"  => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_NIM_PAR"   => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_SRC_ROUTING"       => 0,
            "NETWORK_BCAST"     => 0
        );
        %hats_upper = (
            "REALM"     => "PSSP,,HACMP,,CLUSTER",
            "ENVIRONMENT"       => "scaffold,,cfgmgr",
            "FREQ"      => 30,
            "SENS"      => 40,
            "PRIO"      => 10,
            "LOGL"      => 1000000,
            "MEMP"      => "TEXT,DATA,STACK,,PROC,,NONE",
            "NETWORK_TYPE"      => "ether,,hps,,token,,fddi,,atm,,IP,," .
                "Geo_Primary,,Geo_Secondary,,rs232,,tmscsi,,tmssa,,diskhb",
            "NETWORK_FREQ"      => 30,
            "NETWORK_SENS"      => 40,
            "NETWORK_NIM_EXEC"  => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_NIM_PAR"   => $HATS_CHK_VAL_ANY_VAL,
            "NETWORK_SRC_ROUTING"       => 1,
            "NETWORK_BCAST"     => 1
        );
        %hats_default = (
            "REALM"     => "PSSP",
            "ENVIRONMENT"       => "",
            "FREQ"      => 1,
            "SENS"      => 8,
            "PRIO"      => 38,
            "LOGL"      => 5000,
            "MEMP"      => "PROC",
            "NETWORK_TYPE"      => "",
            "NETWORK_FREQ"      => 1,
            "NETWORK_SENS"      => 8,
            "NETWORK_NIM_EXEC"  => "$RSCT_BIN/hats_nim",
            "NETWORK_NIM_PAR"   => "",
            "NETWORK_SRC_ROUTING"       => 0,
            "NETWORK_BCAST"     => 0
        );
    } else {
        $return_code = -1;
    }
    return($return_code);
}

#=======================================================================#
#                                                                       #
# Function: hats_def_values                                             #
# Description: find the default value of a HATS configuration keyword.  #
#                                                                       #
# Input:                                                                #
#     keyword: keyword name                                             #
# Output:                                                               #
#     keyvalue: the default value of the given keyword                  #
# Return:                                                               #
#     0 : valid value                                                   #
#     -1: invalid value                                                 #
#                                                                       #
#=======================================================================#

sub hats_def_values {
    local ($return_code);
    if (exists($hats_default{$_[0]})) {
        $_[1] = $hats_default{$_[0]};
        $return_code = 0;
    } else {
        $return_code = -1;
    }
    return($return_code);
}

#=======================================================================#
#                                                                       #
# Function: hats_chk_values                                             #
#                                                                       #
# Description: check if the given value is a valid value of the given   #
#     keyword                                                           #
#                                                                       #
# Input:                                                                #
#     keyword: The keyword to be checked                                #
#     keyvalue: The key value to be checked                             #
# Output: None                                                          #
# Return:                                                               #
#     0  : the value is valid for the variable                          #
#     -1 : the variable is not a recognized HATS variable               #
#     -2 : the value is empty or contains bad characters so that the    #
#          value cannot be checked                                      #
#     -3 : the valid values are specified by a range and the value is   #
#          outside of the valid range                                   #
#     -4 : the valid values are specified in a list and the given value #
#          is not in the list                                           #
#                                                                       #
#=======================================================================#

sub hats_chk_values {
    local ($keyword, $keyvalue) = @_;
    local ($lowerside, $upperside, $match);
    local (@valid_lst, @token_lst);
    local ($return_code);

    if ($HATS_DBG{"hats_chk_values"}) {
        print STDERR "hats_chk_values(): keyword=$keyword, " .
            "keyvalue=$keyvalue\n";
    } 
    $keyvalue = de_quote($keyvalue);
    if (exists($hats_lower{$keyword})) {
        if ($hats_lower{$keyword} == $HATS_CHK_VAL_ANY_VAL) {
            $return_code = 0;
            if ($HATS_DBG{"hats_chk_values"}) {
                 print STDERR "hats_chk_values(): keyword=$keyword, " .
                     "keyvalue=$keyvalue, checking bypassed\n";
            }
        } else {
            if (! ($keyvalue =~ m/^[$SPACE_CHARS]*$/)) {
                # hats_chk_values uses ',' for delimiter. Change all
                # space characters to ','.
                $keyvalue =~ s/[$SPACE_CHARS]+/,/g;
                if ($hats_lower{$keyword} == $HATS_CHK_VAL_IS_LIST) {
                    # Non-numeric value with a valid value list
                    # Trailing ',' error cannot be detected when use split()
                    # because the last NULL element is stripped. Need to 
                    # check trailing ',' explicitly.
                    if ($keyvalue =~ /,$/) {
                        # Use "\"$keyvalue\"" because $keyvalue may contain
                        # multiple words.
                        #print STDERR "Cannot have a trailing ',' in keyvalue ".
                        #    "$keyvalue\n";
                        print_message("EMSG855", "$SCRIPT", "\"$keyvalue\"");
                        $return_code = -2;
                    } else {
                        # The following key value matching algorithm is
                        # not trivial. To understand how this algorithm
                        # works, see the comment in the beginning of
                        # hats_chk_values_init().
                        @valid_lst = split(/,,/, $hats_upper{$keyword});
                        @token_lst = split(/,/, $keyvalue);
                        $match = 0;
                        VALID_GROUP: foreach my $valid_group (@valid_lst) {
                            # Put ',' on both ends of the strings to be matched
                            # to avoid matching a substring.
                            $valid_group_comma = "," . $valid_group . ",";
                            # All given tokens must be in the same token group
                            foreach my $token (@token_lst) {
                                $token_comma = "," . $token . ",";
                                if (index($valid_group_comma, $token_comma) < 0) {
                                    next VALID_GROUP;
                                }
                            }
                            $match = 1;
                            last;
                        }
                        $return_code = ($match) ? 0 : -4;
                    }
                } else {
                    # Numeric value with lower and upper bounds
                    # Make sure the given number contains nothing but digits.
                    if ($keyvalue =~ m/^-{0,1}[0-9]+$/) {
                        $lowerside = $keyvalue - $hats_lower{$keyword};
                        $upperside = $keyvalue - $hats_upper{$keyword};
                        $return_code = ($lowerside * $upperside <= 0) ? 0 : -3;
                        # Defect 97577
                        # Priority is a special case because value 0 should be
                        #  accepted, and interpreted as "no fixed prio"
                        if(($keyword eq "PRIO") && ($keyvalue == 0)) {
                            $return_code = 0;
                        }

                    } else {
                        # Use "\"$keyvalue\"" because $keyvalue may contain
                        # multiple words.
                        #print STDERR "Numeric value contains non-numeric ".
                        #    "characters\n";
                        print_message("EMSG856", "$SCRIPT", "\"$keyvalue\"");
                        $return_code = -2;
                    }
                }
            } else {
                # $keyvalue contains only space characters.
                #print STDERR "The value of key word $keyword is missing.\n";
                print_message("EMSG857", "$SCRIPT", "$keyword");
                $return_code = -2;
            }
        }
    } else {
        #print STDERR "Unknown key word $keyword\n";
        print_message("EMSG860", "$SCRIPT", "$keyword");
        $return_code = -1;
    }
    return ($return_code);
}

